TheCaper Postad 14 december, 2015 Share Postad 14 december, 2015 Hej, Har skapat ett Makro med hjälp av internet. Det ser ut så här: Sub Compare2WorkSheets(ws1 As Worksheet, ws2 As Worksheet) Dim ws1row As Long, ws2row As Long, ws1col As Integer, ws2col As Integer Dim maxrow As Long, maxcol As Integer, colval1 As String, colval2 As String Dim report As Workbook, difference As Long Dim row As Long, col As Integer Set report = Workbooks.Add With ws1.UsedRange ws1row = .Rows.Count ws1col = .Columns.Count End With With ws2.UsedRange ws2row = .Rows.Count ws2col = .Columns.Count End With maxrow = ws1row maxcol = ws1col If maxrow < ws2row Then maxrow = ws2row If maxcol < ws2col Then maxcol = ws2col difference = 0 For col = 1 To maxcol For row = 1 To maxrow colval1 = "" colval2 = "" colval1 = ws1.Cells(row, col).Formula colval2 = ws2.Cells(row, col).Formula If colval1 <> colval2 Then difference = difference + 1 Cells(row, col).Formula = colval1 & " " & colval2 Cells(row, col).Interior.Color = 255 Cells(row, col).Font.ColorIndex = 2 Cells(row, col).Font.Bold = True End If Next row Next col Columns("A:R").ColumnWidth = 25 report.Saved = True If difference = 0 Then report.Close False End If Set report = Nothing MsgBox difference & " Celler innehåller olika data! ", vbInformation, " Compare 2 work sheets" End Sub Makrot jämför 2 st blad med varandra. Skapar upp ett nytt blad och visar olikheterna i det nya bladet. Det jag skulle vilja ha med är artikelnumret från kolumn C till det nya bladet. Överkurs är att även plocka bort alla rader där det inte har skett några förändringar. Länk till kommentar Dela på andra webbplatser More sharing options...
Monshi Postad 14 december, 2015 Share Postad 14 december, 2015 För att få över kolumn C... mmh du stegar över kolumner och sedan över rad. Och någonstans vill du där kopiera över kolumn C till någon kolumn på (något blad) som Cells refererar till (adressera bättre!) Undras om inte enklaste blir If colval1 <> colval2 Then If Cells(row, maxCol+1) ="" Then Cells(row, maxCol+1).Value = Ws.cells(row, 4).Value End If .... Dvs kolla om rad kopierad, gör inget då, annars kopiera. Hoppa rader utan skillnad? Då får du skapa en till variabel som stegar upp raderna på bladet du kopierar på, bara räkna upp den när en skillnad finns, när något ska kopieras. Det är mina tankar utan att kunna provköra koden. Länk till kommentar Dela på andra webbplatser More sharing options...
TheCaper Postad 16 december, 2015 Trådskapare Share Postad 16 december, 2015 För att få över kolumn C... mmh du stegar över kolumner och sedan över rad. Och någonstans vill du där kopiera över kolumn C till någon kolumn på (något blad) som Cells refererar till (adressera bättre!) Undras om inte enklaste blir If colval1 <> colval2 Then If Cells(row, maxCol+1) ="" Then Cells(row, maxCol+1).Value = Ws.cells(row, 4).Value End If .... Dvs kolla om rad kopierad, gör inget då, annars kopiera. Hoppa rader utan skillnad? Då får du skapa en till variabel som stegar upp raderna på bladet du kopierar på, bara räkna upp den när en skillnad finns, när något ska kopieras. Det är mina tankar utan att kunna provköra koden. Försökt att lägga upp filen jag arbetar med, men har inte tillstånd till att bifoga denna sortens fil Så bifogar det önskade resultatet för att det ska bli enklare att förstå vad jag är ute efter. Länk till kommentar Dela på andra webbplatser More sharing options...
TheCaper Postad 16 december, 2015 Trådskapare Share Postad 16 december, 2015 Lägger upp hela arket utan makro med nuvarande resultat och önskat resultat i en annan flik. Enklare att förstå vad jag är ute efter än att jag ska försöka förklara det i text Jämföra blad i Excel (utan makro).xls Länk till kommentar Dela på andra webbplatser More sharing options...
Monshi Postad 17 december, 2015 Share Postad 17 december, 2015 Makroaktiverade ark kan du lägga upp om du zippar dem först. Eller som du nu gjort, spara som XLS-fil med makron kvar. men tar titt på det (pinga mig om jag glömmer) en dag då min hjärna är piggare. Länk till kommentar Dela på andra webbplatser More sharing options...
Monshi Postad 25 december, 2015 Share Postad 25 december, 2015 Du kanske gett upp hoppet om svar? En lite julklapp till dig då. Här får du lite kod som ger dig det du önskar. Sub Compare2WorkSheets(ws1 As Worksheet, ws2 As Worksheet) Dim ws1row As Long, ws2row As Long, ws1col As Integer, ws2col As Integer Dim maxrow As Long, maxCol As Integer, colval1 As String, colval2 As String Dim report As Workbook, difference As Long Dim row As Long, col As Integer Dim rwIndex As Integer Dim i As Integer Dim wsTarget As Worksheet 'Set report = Workbooks.Add Set wsTarget = ThisWorkbook.Worksheets.Add With ws1.UsedRange ws1row = .Rows.Count ws1col = .Columns.Count End With With ws2.UsedRange ws2row = .Rows.Count ws2col = .Columns.Count End With maxrow = ws1row maxCol = ws1col If maxrow < ws2row Then maxrow = ws2row If maxCol < ws2col Then maxCol = ws2col difference = 0 rwIndex = 2 With wsTarget For row = 1 To maxrow If HasChanged(ws1.Cells(row, 1).Resize(1, maxCol), ws2.Cells(row, 1).Resize(1, maxCol)) Then For col = 1 To maxCol If (ws1.Cells(row, col).Formula <> ws2.Cells(row, col).Formula) Then .Cells(rwIndex, col).Formula = ws1.Cells(row, col).Formula & " Nytt värde " & ws2.Cells(row, col).Formula .Cells(rwIndex, col).Interior.Color = 255 .Cells(rwIndex, col).Font.ColorIndex = 2 .Cells(rwIndex, col).Font.Bold = True difference = difference + 1 Else .Cells(rwIndex, col) = ws1.Cells(row, col) End If Next col rwIndex = rwIndex + 1 End If Next row If difference > 0 Then .Columns("A:R").ColumnWidth = 25 ws1.Cells(1, 1).Resize(1, maxCol).Copy .Cells(1, 1) End If End With ' report.Saved = True ' If difference = 0 Then ' report.Close False ' End If ' Set report = Nothing MsgBox difference & " Celler innehåller olika data! ", vbInformation, " Compare 2 work sheets" End Sub Function HasChanged(rn1 As Range, rn2 As Range) As Boolean Dim i As Integer For i = 1 To rn1.Columns.Count If rn1.Cells(1, i).Formula <> rn2.Cells(1, i).Formula Then HasChanged = True Exit Function End If Next i HasChanged = False End Function Alla aktioner håller sig ovan inom en bok, lägger till ett nytt blad där data sparas istället för i en ny bok. Länk till kommentar Dela på andra webbplatser More sharing options...
TheCaper Postad 25 december, 2015 Trådskapare Share Postad 25 december, 2015 Helt fantastiskt! Bästa julklappen iår måste jag säga! Det fungerar exakt så som jag vill ha det. Ett jättetack till dig! Länk till kommentar Dela på andra webbplatser More sharing options...
Rekommendera Poster
Arkiverat
Det här ämnet är nu arkiverat och är stängt för ytterligare svar.