Question

我有一个主表，它是一个仪表板样式表，从链接表中提取信息（用于抽查）。工作表的所有结果都由一个单元格（一个 ID）驱动，我有一个 ID 列表，我想通过这些单元格流过这些 ID，然后复制一行结果并将其附加到其他工作表中。我录制了这个函数，试图解释我在做什么。

Sheets("Data Input").Select
Range("L3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=List!R[1]C[-11]"
Rows("32:32").Select
Selection.Copy
Sheets("results").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

然后我做了多次以展示整个过程的样子：

Sheets("Data Input").Select
Range("L3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=List!R[2]C[-11]"
Rows("32:32").Select
Selection.Copy
Sheets("results").Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Data Input").Select
Range("L3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=List!R[3]C[-11]"
Rows("32:32").Select
Selection.Copy
Sheets("results").Select
Range("A5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Data Input").Select
Range("L3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=List!R[4]C[-11]"
Rows("32:32").Select
Selection.Copy
Sheets("results").Select
Range("A6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

所以总共有三张纸。 数据输入，结果和函数所在的位置，列表，其中包含一个 ID 列表，结果，其中我只需要从数据中附加一行输入(row32)

Answer 1

你可以这样做：

    Dim wsList As Worksheet, wsData As Worksheet, wsResult As Worksheet
    Dim c As Range, rwDest As Range
    
    Set wsList = ThisWorkbook.Worksheets("List")
    Set wsData = ThisWorkbook.Worksheets("Data Input")
    Set wsResult = ThisWorkbook.Worksheets("Result")

    Set rwDest = wsResult.Rows(3)                'first destination row
    
    For Each c In wsList.Range("A2:A100").Cells  'for example
        If c.Value <> "" Then
            wsData.Range("L3").Value = c.Value
            wsData.Calculate
            rwDest.Value = wsData.Rows(32).Value 'copy row values
            Set rwDest = rwDest.Offset(1, 0)     'next destination row
        End If
    Next c

循环遍历列表并附加结果 VBA

1 个答案: