☰

Zwei Spalten auf separaten Blättern zu einer einzigen Spalte zusammenführen

tag-icon • tag-icon microsoft-excel worksheet-function vba
Zwei Spalten auf separaten Blättern zu einer einzigen Spalte zusammenführen

Ich habe 2 Listen auf zwei separaten Blättern und versuche, sie in einem dritten Blatt zu kombinieren. Diese Listen werden automatisch basierend auf Benutzereingaben ausgefüllt, sodass die Anzahl der Zeilen in der Liste variieren kann. Sobald in der ersten Spalte von Blatt 1 nichts erkannt wird, beginnt es, die Liste auf Blatt 3 mit den Spalten von Blatt 2 zu füllen, wie folgt

Blatt1

Make    Model     License Plate
Ford    Escape    UVC345
Honda   Civic     KD2YR9

Blatt 2

Make    Model    License Plate 
Dodge   Charger  34TRLS2
VW      Passat   V70YTR

Blatt 3

Make    Model    License Plate
Ford    Escape   UVC345
Honda   Civic    KD2YR9
Dodge   Charger  34TRLS2
VW      Passat   V70YTR

Aktualisieren:

Das Problem, das bei mir auftritt, wenn ich VBA zum Kopieren und Einfügen verwende, besteht darin, dass die Formeln, die zum automatischen Ausfüllen der ursprünglichen Liste auf Blatt 1 verwendet werden, eingefügt und identifiziert werden. Da die Formeln eingefügt werden, wird nicht richtig identifiziert, wo sich die letzte Zelle auf Blatt 3 befindet.

Sub Copy_Alternatives()

Worksheets("CNA eTool Alternatives").Range("A:A").Copy
Worksheets("Repair Replacement Recom").Range("A:A").PasteSpecial xlPasteValues
Worksheets("CNA eTool Alternatives").Range("B:B").Copy
Worksheets("Repair Replacement Recom").Range("B:B").PasteSpecial xlPasteValues
Worksheets("CNA eTool Alternatives").Range("C:C").Copy
Worksheets("Repair Replacement Recom").Range("C:C").PasteSpecial xlPasteValues

End Sub

Sub Copy_Paste_Range()

Dim lNewRow As Long
Dim lDataRow As Long

ThisWorkbook.Activate

lNewRow = Worksheets("CNA eTool Addit. Alternatives").Cells(Worksheets("CNA eTool Addit. Alternatives").Rows.Count, "H").End(xlUp).Row

lDataRow = Worksheets("Repair Replacement Recom").Cells(Worksheets("Repair Replacement Recom").Rows.Count, 1).End(xlUp).Row
lDataRow = lDataRow + 1

Worksheets("CNA eTool Addit. Alternatives").Range("H2:J" & lNewRow).Copy
Worksheets("Repair Replacement Recom").Range("A" & lDataRow).PasteSpecial

End Sub

Antwort1

Sie können dies mit Arbeitsblattfunktionen erstellen.

Nehmen wir an, Ihr erstes Blatt ist Sheet1und das zweite istExtra1

Fügen Sie die folgende Formel in Ihr zusammengeführtes Blatt auf A2 ein und kopieren Sie sie anschließend in die anderen Zellen:

=IF(ROW()>COUNTA(Sheet1!A:A)+COUNTA(Extra1!A:A)-1,"",INDIRECT(IF(ROW()<=COUNTA(Sheet1!A:A),"Sheet1!","Extra1!")&SUBSTITUTE(ADDRESS(1,COLUMN(),4),1,"")&ROW()-IF(ROW()<=COUNTA(Sheet1!A:A),0,COUNTA(Sheet1!A:A)-1)))

Und so funktioniert es:

  1. Überprüft, ob die aktuelle Zeile höher ist als die Zeilenanzahl auf dem ersten Blatt + dem zweiten Blatt minus eins (weil beide Kopfzeilen haben).
  2. Wenn die aktuelle Zeile größer ist, wird sie leer angezeigt. Andernfalls wird mit dem nächsten Schritt fortgefahren.
  3. Bereitet eine vor INDIRECT. Wenn die aktuelle Zeile tiefer liegt als die Zeilen auf dem ersten Blatt, wird der Name des ersten Blatts abgerufen. Andernfalls wird der Name des zweiten Blatts abgerufen.
  4. Es verwendet den SUBSTITUTE + ADDRESSTrick, um den aktuellen Buchstaben der Spalte zurückzugeben. Das ist gut, weil es dann für alle Felder die gleiche Formel verwendet und akzeptiert, selbst wenn die Spalte AA wird
  5. Schließlich ruft es die aktuelle Zeile ab, wenn die aktuelle Zeile kleiner ist als die Anzahl der Elemente auf dem ersten Blatt. Andernfalls ruft es die aktuelle Zeile MINUS der Zeilenanzahl des ersten Blatts minus eins ab, um die Startzeile des zweiten Blatts zurückzugeben.

Ich weiß, es ist etwas überwältigend und schwieriger zu lesen, aber Formeln sind manchmal besser als VBA.

Bearbeiten: Tja, ich hatte eine Erleuchtung und eine funktionierende VBA-Version

Sub merge()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Set ws1 = Sheets("Sheet1") 'First sheet to get merged
Set ws2 = Sheets("Extra1") 'Second sheet to get merged
Set ws3 = Sheets("Merged") 'Name of the sheet you want results
Dim lr As Long 'To return the number of the last row
Dim arrayone As Variant
lr = ws1.Cells(Rows.Count, 1).End(xlUp).Row
arrayone = Range(ws1.Cells(2, 1), ws1.Cells(lr, 3)).Value 'From Row 2 onwards, considering it has headers
Dim arr2 As Variant
lr = ws2.Cells(Rows.Count, 1).End(xlUp).Row
arr2 = Range(ws2.Cells(2, 1), ws2.Cells(lr, 3)).Value 'From Row 2 onwards, considering it has headers
Dim arr3 As Variant
ReDim arr3(1 To UBound(arrayone, 1) + UBound(arr2, 1), 1 To 3)
For i = 1 To UBound(arr3, 1)
    For j = 1 To 3
        If i <= UBound(arrayone, 1) Then
            arr3(i, j) = arrayone(i, j)
        Else
            arr3(i, j) = arr2(i - UBound(arrayone, 1), j)
        End If
    Next j
Next i
Range(ws3.Cells(2, 1), ws3.Cells(UBound(arr3) + 1, 3)).Value = arr3
End Sub

verwandte Informationen