nun, ich habe ein paar Fragen und ein kleines Problem. Der unten stehende Makro ist teils von mir selbst und teils aus diesem Forum.
In diesem Makro werden zwei Tabellenblätter miteinander verglichen und die unterschiedlichen
Einträge herausgefiltert und in ein drittes Tabellenblatt eingefügt. Dies geschieht jedoch nur
mit den ersten vier spalten. Ab der Abschnitt "Programm" ist nicht von mir geschrieben worden,
daher habe dazu auch ein paar Fragen. Was bewirkt der Befehl ...(xlUP).Row? Was passiert genau
in der For ... Next Schleife? Verstanden habe ich bis jetzt vergleiche Zelle X mit Zelle Y und
lösche dann diese, wenn sie gleich sind, aber warum taucht dort nach dem (iRow), eine 1; 2; usw. auf?
Und als letzte Frage zu dem Abschnitt "Programm": Wie und was deviniert iRow und iRowL?
Wie man den verschiedenen InputBox`en entnehmen kann, versuche ich den Makro etwas flexibler zu
gestalten. Der Benutzer soll sich aussuchen können bis zu welcher Spalte verglichen und kopiert werden soll.
Außerdem kann er die Spalte bestimmen in der der Tabellenblatname eingefügt werden soll. Bis jetzt
funktioniert diese Abfrage nur mit der "kSpalte" und der "Ausgabe". Die "vSpalte" bekomme ich nicht in
eine Abfrage gepresst. Habe es schon probiert mit:
If vSpalten = 3 Then
With Worksheets(3)
.Rows(1).Value = wksA.Rows(1).Value
.Rows(1).Font.Bold = True
iRowL = wksA.Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(iRow + 2, 1), .Cells(iRowL, kSpalten)).Value = wksA.Range(wksA.Cells(2, 1), wksA.Cells(iRowL, kSpalten)).Value
.Range(.Cells(iRow + 2, Ausgabe), .Cells(iRowL, Ausgabe)).Value = wksA.Name
iRow = iRowL + 1
iRowL = wksB.Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(iRow, 1), .Cells(iRow + iRowL - 2, kSpalten)).Value = wksB.Range(wksB.Cells(2, 1), wksB.Cells(iRowL, kSpalten)).Value
.Range(.Cells(iRow, Ausgabe), .Cells(iRow + iRowL - 2, Ausgabe)).Value = wksB.Name
iRowL = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A1").CurrentRegion.Sort _
key1:=.Range("A2"), order1:=xlAscending, _
key2:=.Range("B2"), order2:=xlAscending, _
header:=xlYes
For iRow = iRowL To 2 Step -1
If .Cells(iRow, 1).Value = .Cells(iRow - 1, 1).Value And _
.Cells(iRow, 2).Value = .Cells(iRow - 1, 2).Value And _
.Cells(iRow, 3).Value = .Cells(iRow - 1, 3).Value Then
.Rows(iRow).Delete
.Rows(iRow - 1).Delete
End If
Next iRow
End With
End If
GoTo okay
jedoch kopiert er dann gar nichts. Was passiert eigentlich in den Zeilen: ?
.Range("A1").CurrentRegion.Sort _
key1:=.Range("A2"), order1:=xlAscending, _
key2:=.Range("B2"), order2:=xlAscending, _
header:=xlYes
Mein Gott, dass is glaube ich etwas viel für den Anfang. Wer sich hier reinfuchst hat sich ein dickes DANKE verdient!
viele Grüße
Uni
------------------------------------------------
vollständiger Makro-Code:
Sub Vorlage_Zusammenführung()
Programm2:
Dim wksA As Worksheet, wksB As Worksheet
Dim iRow As Integer, iRowL As Integer, Ausgabe As Integer, vSpalten As Integer, kSpalten As Integer
Application.ScreenUpdating = False
Set wksA = Worksheets(1)
Set wksB = Worksheets(2)
Ausgabe = Val(InputBox("Bitte geben Sie die Spalte an, in der der Tabellenbezug ausgegeben werden soll", "Ausgabespalte", 9))
If Ausgabe = 0 Then
GoTo Abbruch
Else
GoTo vSpalten
End If
vSpalten:
vSpalten = Val(InputBox("Geben Sie bitte die Anzahl der zu vergleichenden Spalten ein." & Chr(13) & _
Chr(10) & "HINWEIS: Es wird davon ausgegangen, dass der zu vergleichende Bereich in Spalte A beginnt." & Chr(13) & _
Chr(10) & "HINWEIS: Die Spalte A = !, Spalte B = 2, usw.", "zu vergleichende Spalten", 4))
If vSpalten = 0 Then
GoTo Abbruch
Else
GoTo kSpalten
End If
kSpalten:
kSpalten = Val(InputBox("Geben Sie bitte die Anzahl der zu kopierenden Spalten ein.", "zu kopierende Spalten", 7))
If kSpalten = 0 Then
GoTo Abbruch
Else
GoTo Programm
End If
Programm:
With Worksheets(3)
.Rows(1).Value = wksA.Rows(1).Value
.Rows(1).Font.Bold = True
iRowL = wksA.Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(iRow + 2, 1), .Cells(iRowL, kSpalten)).Value = wksA.Range(wksA.Cells(2, 1), wksA.Cells(iRowL, kSpalten)).Value
.Range(.Cells(iRow + 2, Ausgabe), .Cells(iRowL, Ausgabe)).Value = wksA.Name
iRow = iRowL + 1
iRowL = wksB.Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(iRow, 1), .Cells(iRow + iRowL - 2, kSpalten)).Value = wksB.Range(wksB.Cells(2, 1), wksB.Cells(iRowL, kSpalten)).Value
.Range(.Cells(iRow, Ausgabe), .Cells(iRow + iRowL - 2, Ausgabe)).Value = wksB.Name
iRowL = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A1").CurrentRegion.Sort _
key1:=.Range("A2"), order1:=xlAscending, _
key2:=.Range("B2"), order2:=xlAscending, _
key3:=.Range("C2"), order3:=xlAscending, _
header:=xlYes
For iRow = iRowL To 2 Step -1
If .Cells(iRow, 1).Value = .Cells(iRow - 1, 1).Value And _
.Cells(iRow, 2).Value = .Cells(iRow - 1, 2).Value And _
.Cells(iRow, 3).Value = .Cells(iRow - 1, 3).Value And _
.Cells(iRow, 4).Value = .Cells(iRow - 1, 4).Value Then
.Rows(iRow).Delete
.Rows(iRow - 1).Delete
End If
Next iRow
End With
GoTo okay
okay:
Application.ScreenUpdating = True
MsgBox "Der Vergleich ist abgeschlossen.", , "Hinweis"
GoTo Ende
Abbruch:
Application.ScreenUpdating = True
intvalue = MsgBox("Die Spalte 0 entspricht keiner gültigen Spaltenzuordnung." & Chr(13) & _
Chr(10) & "Möchten Sie die Prozedur wiederholen?", vbExclamation + vbOKCancel, "Fehler")
If intvalue = vbOK Then
GoTo Programm2
Else
GoTo Ende
End If
Ende:
End Sub