Question

我正在尝试创建一个宏，将从A7开始的行从不同的工作表复制到“数据”工作表。每张表格中的行数各不相同。它只是复制每张表中的第7行。这是我的代码：

 Sub Button1_Click()

 Worksheets("Data").Cells.ClearContents

 Dim x As Integer
 Dim y As Integer
 Dim ws1 As Worksheet
 Dim First As Integer
 Dim Last As Integer
 Dim i As Integer

     Set ws1 = Worksheets("Data")
     First = Worksheets("Data").Index
     Last = Worksheets("Summary").Index

     ws1.Range("A" & 1).Value = "Date"
     ws1.Range("B" & 1).Value = "Equipment"
     ws1.Range("C" & 1).Value = "Type"
     ws1.Range("D" & 1).Value = "Qty / Hrs"
     ws1.Range("E" & 1).Value = "Rate"
     ws1.Range("F" & 1).Value = "Cost"

      For i = (First + 1) To (Last - 1)

      With Sheets(i)

          MaxrOw = Cells(Rows.Count, "A").End(xlUp).Row
          x = 7

          Do Until .Range("A" & x).Value = ""
          If Not .Range("I" & x).Value = "" Then

              ws1.Range("A" & MaxrOw + 1).Value = .Range("G" & 2).Value
              ws1.Range("B" & MaxrOw + 1).Value = .Range("A" & x).Value
              ws1.Range("C" & MaxrOw + 1).Value = .Range("B" & x).Value
              ws1.Range("D" & MaxrOw + 1).Value = .Range("G" & x).Value
              ws1.Range("E" & MaxrOw + 1).Value = .Range("H" & x).Value
              ws1.Range("F" & MaxrOw + 1).Value = .Range("I" & x).Value

              x = x + 1
          Else
              x = x + 1

          End If

      Loop

      End With

      Next i

      Columns("A:F").Sort key1:=Range("C1"), Order1:=xlAscending, Header:=xlYes

 End Sub

提前致谢。

Answer 1

Scott Craner修复了你的语法问题，但正如其他人所提到的，你的代码中存在一些效率低下的问题。请看这里作为起点https://msdn.microsoft.com/en-us/library/office/ff726673(v=office.14).aspx。

所以，对于你的代码：

无法依赖循环工作表索引。例如，如果您移动了＆＃34;数据＆＃34;或＆＃34;摘要＆＃34;表格（故意或错误地），您可能会丢失一些表格。循环浏览Worksheets集合并测试每个是否是您想要的工作表（例如其名称），这样更可靠。
每当您从工作表中读取数据时，通常可以更快地读取和写入变体数组。特别是逐个单元地编写电池是非常耗时的。
每行迭代也不需要查找最后一行。更快的是找到它一次，然后每次写一行时简单地添加1。当然，更快仍然是第2点。

以下代码解决了这三个问题。它不是最有效的内存，但会很快。

Dim ws As Worksheet
Dim dataSets As Collection
Dim output() As Variant
Dim dataValues(1) As Variant
Dim d As Long
Dim x As Long
Dim v As Variant

'Acquire the data from each sheet and aggregate the output array size
Set dataSets = New Collection
d = 2
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Data" And ws.Name <> "Summary" Then
        dataValues(0) = ws.Range("G2").Value
        dataValues(1) = ws.Range("A7", ws.Cells(ws.Rows.Count, "A").End(xlUp)).Resize(, 9).Value2
        d = d + UBound(dataValues(1), 1)
        dataSets.Add dataValues
    End If
Next

'Redimension the output array
ReDim output(1 To d, 1 To 6)

'Populate the header
output(1, 1) = "Date"
output(1, 2) = "Equipment"
output(1, 3) = "Type"
output(1, 4) = "Qty / Hrs"
output(1, 5) = "Rate"
output(1, 6) = "Cost"

'Populate the output array with values
d = 2
For Each v In dataSets
    For x = 1 To UBound(v(1), 1)
        output(d, 1) = v(0)
        output(d, 2) = v(1)(x, 1)
        output(d, 3) = v(1)(x, 2)
        output(d, 4) = v(1)(x, 7)
        output(d, 5) = v(1)(x, 8)
        output(d, 6) = v(1)(x, 9)
        d = d + 1
    Next
Next

'Write the array
ThisWorkbook.Worksheets("Data").Range("A1").Resize(UBound(output, 1), UBound(output, 2)).Value = output

将具有不同行号的不同表格中的行复制到单个表格

1 个答案: