Question

我喜欢在VBA中创建一个宏的建议，它会循环遍历一个工作表中的值数组，复制两个字段的值，将这些值粘贴到另一个工作表中，然后复制并粘贴输出将这些值中的计算返回到原始行旁边的orignal工作表中。

在（非常精简的）示例中，我在一个工作簿中有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.

然后需要将此输出粘贴回＆＃34; VALUES＆＃34;在空白列的各行。

值工作集如下：

下面的公式工作集：

上面我在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

我的下一个工作是将上面的代码包装成有用的东西，这些代码将重复在＆＃34;论坛＆＃34;工作表，同时沿着＆＃34;值＆＃34;中的行向下工作。工作表。

我已经找到了很多关于如何循环/遍历行的示例，但没有关于如何在工作表之间跳转以及从一个到另一个之间复制/粘贴等方面做的事情。

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

感谢任何建议。

编辑：为了澄清，我不需要在Formulas工作表中创建任何其他行 - 此工作表仅用于对从{{粘贴的数据执行计算1}}。然后需要将Values中生成的输出粘贴回2个输出列中的Formulas工作表 - 这是循环行需要发生的地方。

编辑2 ：我已经创建了一个演示手动过程的GIF，我希望使用VBA进行复制

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

Answer 1

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

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

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提供的一些代码，我设法创建了“工作”的东西（每个子需要独立执行，因为我还没想出如何将多个子脚本串成一个脚本）。 / p>

这是我用过的代码：

<TEAMCITY_DATA_DIRECORY>/plugins

这就是它的作用：

VBA迭代行，使用多个工作表

2 个答案: