☰

將不同工作表上的 2 列合併為一列

tag-icon • tag-icon microsoft-excel worksheet-function vba
將不同工作表上的 2 列合併為一列

我在兩張單獨的紙上有兩個列表，我正在嘗試將它們合併到第三張紙中。這些清單會根據使用者輸入自動填充，因此清單中的行數可能會有所不同。因此，一旦它在工作表 1 的第一列中偵測到任何內容，它就會開始使用工作表 2 中的列填充工作表 3 上的列表，如下所示

表1

Make    Model     License Plate
Ford    Escape    UVC345
Honda   Civic     KD2YR9

表2

Make    Model    License Plate 
Dodge   Charger  34TRLS2
VW      Passat   V70YTR

表3

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

更新：

當我使用 VBA 複製和貼上時遇到的問題是，它正在貼上和識別用於自動填充工作表 1 上的初始列表的公式。 3 頁上。

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

答案1

您可以使用工作表函數來實作。

假設您的第一張表是Sheet1，第二張表是Extra1

將下列公式放在 A2 上的合併工作表上，然後複製並貼上到其他儲存格：

=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)))

這是如何運作的：

  1. 檢查目前行是否高於第一張紙+第二張紙減一的行數（因為兩者都有標題）；
  2. 如果目前行較大，則顯示為空。否則，進入下一步；
  3. 準備一個INDIRECT.如果目前行低於第一個工作表上的行，則取得第一個工作表名稱。否則它會取得第二個工作表名稱；
  4. 它使用SUBSTITUTE + ADDRESS技巧來傳回列的當前字母。這很好，因為它在所有欄位上使用相同的公式，甚至當列變為 AA 時也接受
  5. 最後，如果目前行低於第一張工作表上的項目數，則取得目前行，否則取得目前行減去第一張工作表的行數，再減一，以傳回第二張工作表的起始行。

我知道它有點難以理解並且難以閱讀，但公式有時比 VBA 更好。

編輯：好吧，我頓悟了，得到了一個可以工作的 VBA 版本

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

相關內容