Question

我有大约30个工作表，每个工作表有20多列，行数很多。如何告诉Excel选择包含每个工作表第二行中文本的最后一列并将它们放在新工作表中？以下代码似乎很接近：

Sub CopyRange()
    Dim bottomD As Integer
    Dim ws As Worksheet
    For Each ws In Sheets(Array("A", "B", "C", "D"))
        ws.Activate
        bottomD = Range("D" & Rows.Count).End(xlUp).Row
        Range("A2:D" & bottomD).Copy Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    Next ws
End Sub

而不是bottomD = Range("D" & Rows.Count).End(xlUp).Row我应该能够使用像furthest = Range(Columns.Count & "2").End(xlRight).Column这样的东西。我有几个问题：

1）我的第一次改变是否有意义？

2）有没有办法让宏观察循环而不是Sheets(Array("A", "B", "C", "D"))？在我的情况下，工作表都具有相似的名称，因此可以简单地枚举工作表编号i的Array("Name" & i)。

Answer 1

可以使用Worksheets集合中的索引访问循环中的工作表。请参阅下面的代码。

除非您使用的是16位计算机，否则请使用数据类型Long而不是Integer。 Integer指定一个16位数字，在32位计算机上需要特殊处理。此外，对于Excel 2007及更高版本，Integer不足以容纳更大的行号。

避免激活工作表，因为它是一个缓慢的命令。如果必须激活工作表，请包括

Application.ScreenUpdating = False

每次切换工作表时，

会减少屏幕闪烁，因为屏幕重新绘制，

furthest = Range(Columns.Count & "2").End(xlRight).Column是正确的想法，但实施是错误的。 Columns.Count返回您的Excel版本的列数。对于Excel 2003，有256列。更高版本有16384列。因此，您要指定Range(2562)或Range(163842)。请参阅下面的代码以获取正确的语法。

我不明白Range("A2:D" & bottomD).Copy Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)您说要复制列，但Range("A2:D" & bottomD)不是列。然后，您将所有源列放在工作表“摘要”的A列中。这真的是你想要的吗？在下面的代码中，我将源列放在由工作表名称为首的工作表中，我认为这是一个更有用的安排。如果这不是您想要的，我可以调整代码以提供您想要的结果。

Option Explicit
Sub MergeColumns()

  Dim ColSrcCrnt As Long
  Dim ColSumCrnt As Long
  Dim InxWsht As Long
  Dim RowSrcLast As Long
  Dim WshtSum As Worksheet

  Set WshtSum = Worksheets("Summary")

  ' Clear existing contents
  WshtSum.Cells.EntireRow.Delete
  ColSumCrnt = 1

  For InxWsht = 1 To Worksheets.Count

    With Worksheets(InxWsht)
      If .Name <> "Summary" Then

        ' Write worksheet name to row 1 of current column of "Summary"
        WshtSum.Cells(1, ColSumCrnt).Value = .Name

        ' This worksheet is not the summary so find the last
        ' column with a value in row 2.
        ColSrcCrnt = .Cells(2, Columns.Count).End(xlToLeft).Column

        If .Cells(Rows.Count, ColSrcCrnt).Value <> "" Then
          ' Bottom cell of column used.  It will be lost.  Colour
          ' worksheet name to report error.
          WshtSum.Cells(1, ColSumCrnt).Font.Color = RGB(255, 0, 0)
          RowSrcLast = Rows.Count - 1
        Else
          ' There is room for entire column in Summary
          RowSrcLast = .Cells(Rows.Count, ColSrcCrnt).End(xlUp).Row
        End If

        ' Copy column
        .Range(.Cells(1, ColSrcCrnt), _
               .Cells(RowSrcLast, ColSrcCrnt)).Copy Destination:=WshtSum.Cells(2, ColSumCrnt)

        ColSumCrnt = ColSumCrnt + 1     ' Step ready for next worksheet

      End If

    End With

  Next

End Sub

复制和合并多个工作表中的最后一列

1 个答案: