VBA复制和粘贴数据

Question

我是VBA的新手，正在尝试为以下内容创建VBA功能 例如：

在输入表中，首先我想将第1组的B和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标签。您可以在B2标签的output中撰写此公式，然后将其复制/粘贴到B列：

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

修改

如果您坚持使用tool表单，请尝试此操作，假设您在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) 然后拖下这个公式。