VBA复制和粘贴数据

Question

我是VBA的新手，我正在尝试为以下示例创建VBA函数：

在输入表中，首先我想将组B的C和C组中的值复制并粘贴到工具选项卡中，然后我想从工具选项卡中获取单元格E2的值并将其粘贴到输出的单元格B2中选项卡，然后对于组2,3,4重复相同的步骤......直到空行。

有人能帮助我吗？ 非常感谢！

Sub test()
   Dim i As Integer
   Dim j As Integer
   lr = Worksheets("input").Range("A" & Rows.Count).End(xlUp).Row
   lrj = Worksheets("output").Range("A" & Rows.Count).End(xlUp).Row
   For j = 2 To lrj
      Sheets("input").Select
      For i = 1 To lr
         If Sheets("input").Cells(i, 1) = Sheets("output").Range("A2").Offset(j - 2, 0) Then
            Range(Cells(i, 2), Cells(i, 3)).Select
            Selection.Copy
            Sheets("tool").Select
            Range("A2").Offset(i - 2, 0).Select
            ActiveSheet.Paste
            Sheets("input").Select
         End If
      Next i
      Sheets("tool").Select
      Range("E2").Select
      Selection.Copy
      Sheets("output").Select
      Range("B2").Select
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   Next j
End Sub

Answer 1

你不需要通过中间tool选项卡。 您可以在output选项卡的B2中编写此公式，然后沿B列复制/粘贴它：

=SUMPRODUCT((input!$B:$B+input!$C:$C)*(input!$A:$A=A2))

编辑

如果你坚持使用tool表，试试这个，假设你在tool!E2有一个有效的公式tool!E2 ：

Sub useTheToolSheet()
  Dim grp As Range, src As Range
  Set grp = Worksheets("input").Range("A2")
  Do While IsNumeric(grp.Value2)
  Set src = grp.Offset(, 1).Resize(, 2)
    Do While grp.Value2 = grp.Offset(1).Value2
       Set grp = grp.Offset(1)
       Set src = src.Resize(src.Rows.Count + 1)
    Loop
    Worksheets("tool").UsedRange.Offset(1).Resize(, 2).ClearContents
    Worksheets("tool").Range("A2").Resize(src.Rows.Count, src.Columns.Count).Value = src.Value2
    Worksheets("output").Range("B2").Value = Worksheets("tool").Range("E2").Value2
    Set grp = grp.Offset(1)
  Loop
End Sub

Answer 2

你真的需要一个工具标签吗？ 您只需在输出选项卡中使用以下公式： =Sumif(input!A:A,A3,input!B:C)并向下拖动此公式。