vba - 如何将从不同工作表横向放置的相同列复制到单个工作表中？

Question

我的工作簿中有 50 个工作表。 a、b、c、d 列与 e、f、g、h 列相同，但两组可能具有不同的行数/观察值。我需要将所有内容合并到一张只有 3 列的表格中。我需要附加列名，从第 3 行开始复制和粘贴(值)(直到数据结束)。我也尝试录制宏，但在这种情况下，我必须手动浏览所有工作表。有人可以引导我走向正确的方向吗？我对 VBA 非常陌生，我们将不胜感激。我录制的用于复制 2 张纸的宏是这样的:

Sheets("page 9").Select
Range("A3:D3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets.Add After:=Sheets(Sheets.Count)
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Selection.End(xlDown).Select
Range("A67").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("page 9").Select
Range("E3:H3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Selection.End(xlDown).Select
Range("A132").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("page 10").Select
Range("A65").Select
Selection.End(xlUp).Select
Range("A3:D3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Selection.End(xlDown).Select
Range("A197").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("page 10").Select
Range("E3:H3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Selection.End(xlUp).Select
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Date"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Type"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Size"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Discount"
Range("A1").Select
 End Sub

Answer 1

我怀疑任何人都可以破译这段代码。当然我缺乏这个能力。

宏记录器是学习新命令语法的好方法，但它不会产生“好的”代码。它不知道你的目标并记录你做的每一个小步骤。

花时间学习 Excel VBA。在互联网上搜索“Excel VBA 教程”或访问一个好的图书馆或书店并选择 Excel VBA Primer。有很多可供选择，所以我相信你会找到适合你学习风格的东西。这项研究将很快返回您的投资。

查看 StackOverflow 上的 excel-vba 问题。许多，也许是大多数，目前对你没有兴趣。但有些会展示你不知道但很有用的技术。也许学习 VBA 最困难的方面是发现什么是可能的。一旦知道语句 X 存在，就可以查找并研究它的语法和功能。

下面是四个演示相关代码的宏。将它们复制到工作簿并尝试它们。您不可能通过对宏记录器输出的研究来学习如何编写这些宏。

一个 此宏将每个工作表的名称输出到即时窗口。

Sub A()

  Dim InxWsht As Long

  For InxWsht = 1 To Worksheets.Count
    Debug.Print Worksheets(InxWsht).Name
  Next

End Sub

乙这会在当前列表的末尾添加一个新工作表并将其命名为“合并”。然后它会创建一个粗体的彩色标题行。
Range(CellId).Value是访问单元格值的一种方式。我用过"A1"作为单元格的 ID，但这只是一个字符串，可以在运行时构建。 Cells(RowId, ColId).Value是另一种方式。 RowId必须是数字或整数变量。 ColId可以是数字、整数变量或列字母。我建议你保持一致，不要像我一样混搭。

我展示了两种指定范围的方法，因此我可以在单个语句中将整个标题行设置为粗体和着色。

如果我写了Range("A1").Value = "Date"此语句将在事件工作表的单元格 A1 上运行。 .之前 Range表示此语句对 With 中标识的工作表的单元格 A1 进行操作陈述。使用 With意味着我不必使用 Select 切换工作表这是一个缓慢的命令。

Sub B()

  Dim WhshtCons As Worksheet

  Set WhshtCons = Sheets.Add(After:=Sheets(Sheets.Count))

  WhshtCons.Name = "Consolidate"

  With WhshtCons

    .Range("A1").Value = "Date"
    .Cells(1, 2).Value = "Type"
    .Cells(1, "C").Value = "Size"
    .Cells(1, 4).Value = "Discount"

    .Range("A1:D1").Font.Bold = True
    .Range(.Cells(1, 1), .Cells(1, "D")).Font.Color = RGB(0, 128, 128)

  End With

End Sub

中号这将输出除“合并”之外的每个工作表的单元格 A1 的值。

Sub C()

  Dim InxWsht As Long

  For InxWsht = 1 To Worksheets.Count
    If Worksheets(InxWsht).Name <> "Consolidate" Then
      With Worksheets(InxWsht)
        Debug.Print "Cell A1 of Worksheet " & .Name & " contains [" & _
                    .Cells(1, 1).Value & "]"
      End With
    End If
  Next

End Sub

电话 我不会解释这个宏，因为它比其他宏要高级一些。它演示了将所有其他工作表中的数据列移动到工作表“合并”。我怀疑这是否接近你所寻求的，但它表明你所寻求的是可能的。

Sub D()

  Dim ColConsCrnt As Long
  Dim InxWsht As Long
  Dim RowLast As Long
  Dim WhshtCons As Worksheet

  ColConsCrnt = 1

  Set WhshtCons = Worksheets("Consolidate")
  WhshtCons.Cells.EntireRow.Delete

  For InxWsht = 1 To Worksheets.Count
    If Worksheets(InxWsht).Name <> "Consolidate" Then
      With Worksheets(InxWsht)
        RowLast = .Cells(Rows.Count, "A").End(xlUp).Row
        WhshtCons.Cells(1, ColConsCrnt).Value = .Name
        .Range(.Cells(1, "A"), .Cells(RowLast, "A")).Copy _
                            Destination:=WhshtCons.Cells(2, ColConsCrnt)
      End With
      ColConsCrnt = ColConsCrnt + 1
    End If
  Next

End Sub

欢迎编程。我希望你和我一样觉得它很有趣。