☰

将不同工作表上的两列合并为一列

tag-icon • tag-icon microsoft-excel worksheet-function vba
将不同工作表上的两列合并为一列

我在两个单独的工作表上有 2 个列表，我想将它们合并到第三个工作表中。这些列表会根据用户输入自动填充，因此列表中的行数可能会有所不同。因此，一旦它检测到第一张工作表的第一列中没有任何内容，它就会开始用第二张工作表中的列填充第三张工作表上的列表，如下所示

第 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

相关内容