☰

将数据与不同的标题组合在一起

tag-icon • tag-icon microsoft-excel vba macros
将数据与不同的标题组合在一起

我有多个工作表，其中大多数具有相同的标题，但一个（1）工作表具有不同的标题

我有这段代码可以将它们全部结合起来

Sub combined()

Dim xWs As Worksheet
On Error Resume Next

Set xWs = ActiveWorkbook.Worksheets.Add(Sheets(1))
xWs.name = "Combined"
Worksheets(2).Range("A1").EntireRow.Copy Destination:=xWs.Range("A1")
For i = 2 To Worksheets.Count
    Worksheets(i).Range("A1").CurrentRegion.Offset(1, 0).Copy _
           Destination:=xWs.Cells(xWs.UsedRange.Cells(xWs.UsedRange.Count).Row + 1, 1)

Next

Dim s As Worksheet, t As String
Dim j As Long, K As Long
K = Sheets.Count

For j = K To 1 Step -1
    t = Sheets(j).name
    If t <> "Combined" Then
        Application.DisplayAlerts = False
            Sheets(j).Delete
        Application.DisplayAlerts = True
    End If
Next j

子目录结束

它工作得很好，但我想将我的 1 张表插入到 D 列的最后一列

sheet3 不包含另一张表示例的前 3 列

Sheet1、Sheet2 和 Sheet 4 包含以下列

Branch | Population | Store | name | age | ...

而 sheet3 包含

name | age | ...

其余的都相同，只有前 3 列不同。我不知道要添加什么代码才能将其插入到指定的列中。

哦，它们包含不同的数据值

谢谢！

答案1

简单但不太动态的方法是更改​​ sheet3 的复制过程。只需if在循环中添加一个，如下所示：

For i = 2 To Worksheets.Count
    If i <> 4 Then
        Worksheets(i).Range("A1").CurrentRegion.Offset(1, 0).Copy _
           Destination:=xWs.Cells(xWs.UsedRange.Cells(xWs.UsedRange.Count).Row + 1, 1)
    Else
        Worksheets(i).Range("A1").CurrentRegion.Offset(1, 0).Copy _
           Destination:=xWs.Cells(xWs.UsedRange.Cells(xWs.UsedRange.Count).Row + 1, 4)

    End If
Next i

这会将整个“粘贴”部分移动工作表 3 的 3 列。

根据其他工作表的列如何变化，您可以计算列数并进行相应的移动，甚至无需使用语句if。

如果从左到右始终缺少列，并且 Sheet1 被用作表格大小的基础（如此代码中所示），那么您可以做一些更动态的事情，如下所示：

Dim xWs As Worksheet, i As Long, lCol As Long, mCol As Long

Set xWs = ActiveWorkbook.Worksheets.Add(Sheets(1))
xWs.Name = "Combined"
mCol = Worksheets(2).Cells(1, Columns.Count).End(xlToLeft).Column + 1
Worksheets(2).Range("A1").EntireRow.Copy Destination:=xWs.Range("A1")
For i = 2 To Worksheets.Count
        lCol = Worksheets(i).Cells(1, Columns.Count).End(xlToLeft).Column
        Worksheets(i).Range("A1").CurrentRegion.Offset(1, 0).Copy _
           Destination:=xWs.Cells(xWs.UsedRange.Cells(xWs.UsedRange.Count).Row + 1, mCol - lCol)
Next i

或者一些更高级的方法，比较每列的名称。

相关内容