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

时间:2014-01-26 08:49:45

标签: excel vba excel-vba

我在工作簿中有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

1 个答案:

答案 0 :(得分:3)

我怀疑任何人都可以解密这段代码;当然我缺乏能力。

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

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

查看StackOverflow上的excel-vba问题。许多人,也许是大多数人,对你来说都没有兴趣。但有些人会展示你不了解但有用的技巧。也许学习VBA最困难的方面是发现什么是可能的。一旦您知道语句X存在,您就可以查找并研究其语法和功能。

以下是展示相关代码的四个宏。将它们复制到工作簿并尝试它们。您无法从宏记录器输出的研究中学习如何编写这些宏。

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

Sub A()

  Dim InxWsht As Long

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

End Sub

B 这会在当前列表的末尾添加一个新工作表,并将其命名为“合并”。然后它会创建一个粗体彩色标题行。

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

C 这将输出除“合并”之外的每个工作表的单元格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

D 我不会解释这个宏,因为它比其他宏更先进。它演示了将所有其他工作表中的数据列移动到工作表“Consolidate”。我怀疑这与你所寻求的接近,但它表明你所寻求的是可能的。

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

欢迎编程。我希望你能像我一样有趣。