Question

这是我第一次使用本网站，如果有人能帮我在Excel中编写Macro代码来执行以下操作，我将非常感激。

情况：

我有8个名为Data A，Data B，...，Data H的数据表。
我有一个名为Summary的摘要表。
在8个数据表的每一个数据表中， n 来自单元格C8和水平（即C8，D8，{{1}的ID数量}，...）。
每个ID都在垂直单元格下有相关数据。（即单元格E8中的ID包含C8，C9，C10，C13，C14）的相关数据。

待办事项：

激活宏后，转到C15，从Data A开始检查单元格是否为空。
如果单元格不为空，请复制单元格C8中的ID（字符串和数字组合）以及（C8到C9）和（{{1}的相关数据（C10张到C13张（C15到Summary）。
复制后，移至A1张上A6的下一个单元格，重复步骤2.此时，复制的目的地为D8到Data A在B1表上。
如果B6表上第8行的单元格为空，请移至下一个数据表（Summary）。
重复步骤2,3和4，直到在Data A表单上找到空单元格。

我希望能找到能够做到这一点的人。

这是我到目前为止（请理解我是VBA的初学者）：

Data B

Answer 1

未测试：

Sub CopyToSummary()

Dim arrSheets, i As Integer
Dim rngId As Range, rngSummary As Range

    arrSheets = Array("A", "B", "C", "D", _
                      "E", "F", "G", "H")

    Set rngSummary = ThisWorkbook.Sheets("Summary").Range("A1")

    For i = LBound(arrSheets) To UBound(arrSheets)

        Set rngId = ThisWorkbook.Sheets("Data " & arrSheets(i)).Range("C8")
        Do While Len(rngId.Value) > 0

            With rngSummary
                .Value = rngId.Value
                .Offset(1, 0).Value = rngId.Offset(1, 0).Value
                'etc for the other values
            End With

            Set rngSummary = rngSummary.Offset(0, 1)
            Set rngId = rngId.Offset(0, 1)
        Loop

    Next i

End Sub

在某些条件下自动传输数据

1 个答案: