VBA 遍历行，使用多个工作表

Question

我想要一些关于在 VBA 中创建宏的建议，它将遍历一个工作表中的一组值，复制两个字段的值，将这些值粘贴到另一个工作表中，然后复制和将在这些值中进行的计算的输出粘贴回原始行旁边的原始工作表中。

在（非常精简）示例中，我在一个工作簿中有 2 个工作表

 Worksheet:     Values
 Contains 4 columns. (A,B,C &D).  
 Columns A and B each contain a list of numbers
 Columns C and D are empty, waiting to be populated based on a 
 calculation made from columns A and B (calculation takes place in a seperate worksheet).

 Worksheet:     Formula
 Contains 2 fields to enter data (pasted from VALUES:colums A & B)
 Also contains 2 calculation fields which produce the output.

然后需要将此输出粘贴回 "VALUES" 空白列中的相应行。

下面的值工作集：

下面的公式工作集：

我在上面 VBA 中解释的过程是这样的：

Sub value_paster()
'
' value_paster Macro
'

'
    Sheets("Values").Select
    Range("A2:B2").Select
    Selection.Copy
    Sheets("Formula").Select
    Range("A2").Select
    ActiveSheet.Paste
    Range("C2:D2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Values").Select
    Range("C2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

我的下一个工作是将上面的代码包装成一些有用的东西，它将重复在 "Forumla" 工作表中进行的相同过程，同时在 "Values" 工作表中逐行向下工作。

我找到了很多关于如何 loop/iterate 遍历行的例子，但没有太多关于如何在工作表之间跳转和 copying/pasting 从一个到另一个等时如何做到这一点的例子。

注意：对工作表中的数据进行的实际计算比较复杂，无法合并到代码中。

非常感谢任何建议。

编辑： 澄清一下，我不需要在 Formulas 工作表中创建任何额外的行 - 此工作表仅用于对粘贴的数据执行计算来自 Values。然后需要将 Formulas 中生成的输出粘贴回 2 个输出列中的 Values 工作表 - 这是需要循环遍历行的地方。

编辑 2：我创建了一个 gif 演示我想使用 VBA

复制的手动过程

请注意，这不是我将使用的实际工作簿，它只是针对此问题的快速演示）

Answer 1

我相信下面的代码将满足您的需要，假设您只需要单元格的值并完全假设您提供的模式。

请注意，我还在迭代 Formula 工作表中的行。如果计算公式仅在 Formula 工作表的 C1 和 D1 单元格中，则必须更改代码。

Sub value_paster()

    Dim wsValues: Set wsValues = ThisWorkbook.Worksheets("Values")
    Dim wsFormula: Set wsFormula = ThisWorkbook.Worksheets("Formula")

    Dim iRow: iRow = 1
    Do While wsValues.Cells(iRow, 1).Value <> ""
        Dim lngA: lngA = wsValues.Cells(iRow, 1).Value
        Dim lngB: lngB = wsValues.Cells(iRow, 2).Value

        wsFormula.Cells(iRow, 1).Value = lngA
        wsFormula.Cells(iRow, 2).Value = lngB

        Dim lngC: lngC = wsFormula.Cells(iRow, 3).Value
        Dim lngD: lngD = wsFormula.Cells(iRow, 4).Value

        wsValues.Cells(iRow, 3).Value = lngC
        wsValues.Cells(iRow, 4).Value = lngD

        iRow = iRow + 1
    Loop

End Sub

编辑： 根据 OP 的最新信息，我正在添加替代解决方案。可能有更好的方法来做到这一点（我承认我对这个的表现不满意）但我目前无法改进它。希望这对你有用：

Sub value_paster()

    Application.ScreenUpdating = False   ' To freeze screen while the sub is performed


    Dim wsValues: Set wsValues = ThisWorkbook.Worksheets("Values")
    Dim wsFormula: Set wsFormula = ThisWorkbook.Worksheets("Formula")

    Dim iRow: iRow = 2
    Do While wsValues.Cells(iRow, 1).Value <> ""
        Dim lngA: lngA = wsValues.Cells(iRow, 1).Value
        Dim lngB: lngB = wsValues.Cells(iRow, 2).Value

        wsFormula.Cells(2, 1).Value = lngA  ' You are making simple copy/paste here, so working with Selection can be avoided.
        wsFormula.Cells(2, 2).Value = lngB  ' Same goes here. Simple copy/paste can be done by assigning values, without using Selection

        wsFormula.Activate
        wsFormula.Range("C2:D2").Select
        Application.CutCopyMode = False
        Selection.Copy

        wsValues.Activate
        wsValues.Range(wsValues.Cells(iRow, 3), wsValues.Cells(iRow, 4)).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        iRow = iRow + 1
    Loop

    Application.ScreenUpdating = True   ' Reenables screen updating 


End Sub

Answer 2

多亏了 Victor 提供的一些代码，我已经设法创建了 "works" 的东西（每个子都需要独立执行，因为我还没有弄清楚如何将多个子脚本串成一个脚本）。

这是我使用的代码：

Sub value_paster_PT1()
'

'
  Dim wsValues: Set wsValues = ThisWorkbook.Worksheets("Values")
  Dim wsFormula: Set wsFormula = ThisWorkbook.Worksheets("Formula")

    Sheets("Values").Select
    Dim iRow: iRow = 2
    Do While wsValues.Cells(iRow, 1).Value <> ""
        Dim lngA: lngA = wsValues.Cells(iRow, 1).Select
        Selection.Copy
        Sheets("Formula").Select
        Range("A2").Select
        ActiveSheet.Paste
        Range("C2").Select
        Application.CutCopyMode = False
        Selection.Copy

        Sheets("Values").Select
        wsValues.Cells(iRow, 3).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        iRow = iRow + 1
    Loop

End Sub

Sub value_paster_PT2()

  Dim wsValues: Set wsValues = ThisWorkbook.Worksheets("Values")
  Dim wsFormula: Set wsFormula = ThisWorkbook.Worksheets("Formula")

    Sheets("Values").Select
    Dim iRow: iRow = 2
    Do While wsValues.Cells(iRow, 2).Value <> ""
        Dim lngB: lngB = wsValues.Cells(iRow, 2).Select
        Selection.Copy
        Sheets("Formula").Select
        Range("B2").Select
        ActiveSheet.Paste
        Range("D2").Select
        Application.CutCopyMode = False
        Selection.Copy

        Sheets("Values").Select
        wsValues.Cells(iRow, 4).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        iRow = iRow + 1
    Loop


End Sub

这是它的作用：

VBA 遍历行，使用多个工作表

VBA to iterate through rows, working with multiple worksheets

excel

foreach

vba

excel-2013