遍历范围，在单独的工作表中查找值，复制值并返回并粘贴

Question

我有一个录制的宏，我想让它变得更加智能和免维护。宏是非常具体的，因为单元地址和值是硬编码的。如果值列表发生更改，则必须编辑宏代码。对我来说不是问题，但未来的用户可能没有这方面的知识或倾向。

我认为循环是最佳解决方案，但我不确定如何继续。

以下是代码的当前版本：

    '======= APPROVED
    Sheets("Worksheet").Visible = True  -- Unhide the "Worksheet" tab
    Sheets("Worksheet").Select
    Range("B8").Select                  -- go to cell B8
    ActiveCell.FormulaR1C1 = "Approved" -- type "Approved"

'C9755
'Expense and Lease Current Year
    Range("B2").Select                  -- Go to cell for search value
    ActiveCell.FormulaR1C1 = "C9755"    -- Type in "C9755" (first item)
    Range("I1:T1").Select               -- Copy the total in the range
    Selection.Copy
    Sheets("Summary by Component").Select -- Go back to other tab
    Range("C9").Select                    -- This is where "C9755" is
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'Capital Depreciation
    Sheets("Worksheet").Select    -- Now go back and do the same for Capital
    Range("I2:T2").Select
    Selection.Copy
    Sheets("Summary by Component").Select
    Range("C35").Select   -- This is where "C9755" Capital is
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

流动图片： Flow

Answer 1

您必须提供更多详细信息＆＃34;如果值列表发生更改，则必须编辑宏代码＆＃34;

价值清单中的变化是什么？细胞值或范围的变化？标准是什么？

使用循环管理您的问题似乎很简单。您可以在此处简单解释其工作原理：http://www.excel-pratique.com/en/vba/loops.php

<强> 修改

您可能需要进行一些更改，因为我不确定您希望代码执行的确切操作，但请尝试使用以下内容：

Sub LoopWhile()

i = 9

While Sheets("Summary by Component").Cells(i, 2).Value <> ""

    Sheets("Summary by Component").Cells(i, 2).Copy

    Sheets("Worksheet").Select
    Cells(2, 2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range(Cells(1, 9), Cells(1, 20)).Copy
    Sheets("Summary by Component").Select
    Cells(35, 3).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    i = i + 1

Wend

End Sub

Answer 2

这是我想出的。我确信它可能更紧，所以任何建议都非常感激：

' Turn off screen updating so you don't see windows jumping around
    Application.ScreenUpdating = False

    Sheets("Worksheet").Visible = True
    Sheets("Summary by Component").Select

    'Expense and Lease - Approved
    Dim LSearchRowA As Integer
    Dim LCopyToRowSummA As Integer
    LSearchRowA = 9
    LCopyToRowSummA = 9

    'Capital - Approved
    Dim LSearchRowB As Integer
    Dim LCopyToRowSummB As Integer
    LSearchRowB = 35
    LCopyToRowSummB = 35

    'Expense and Lease - Potential Buy
    Dim LSearchRowC As Integer
    Dim LCopyToRowSummC As Integer
    LSearchRowC = 62
    LCopyToRowSummC = 62

    'Capital - Potential Buy
    Dim LSearchRowD As Integer
    Dim LCopyToRowSummD As Integer
    LSearchRowD = 88
    LCopyToRowSummD = 88


'======= Start components updates =======
'Wend through Approved Expense and Lease
    While Len(Range("P" & CStr(LSearchRowA)).Value) > 0

        'Select row in "Summary by Component" to copy
        Range("B" & CStr(LSearchRowA)).Select
        Selection.Copy

        'Paste selection into Component field on "Worksheet" tab
        Sheets("Worksheet").Select
        Range("B2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Range("B8").Select
        ActiveCell.FormulaR1C1 = "Approved"

        'Copy Expense and Lease Totals and copy to "Summary by Component" tab
        Range("I1:T1").Select
        Selection.Copy
        Sheets("Summary by Component").Select
        Range("C" & CStr(LCopyToRowSummA)).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        LSearchRowA = LSearchRowA + 1
        LCopyToRowSummA = LCopyToRowSummA + 1

       'Go back to "Summary by Component" tab to continue
        Sheets("Summary by Component").Select
    Wend

'Wend through Approved Capital
    While Len(Range("P" & CStr(LSearchRowB)).Value) > 0

        'Select row in "Summary by Component" to copy
        Range("B" & CStr(LSearchRowB)).Select
        Selection.Copy

        'Paste selection into Component field on "Worksheet" tab
        Sheets("Worksheet").Select
        Range("B2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        'Copy Expense and Lease Totals and copy to "Summary by Component" tab
        Range("I2:T2").Select
        Selection.Copy
        Sheets("Summary by Component").Select
        Range("C" & CStr(LCopyToRowSummB)).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        LSearchRowB = LSearchRowB + 1
        LCopyToRowSummB = LCopyToRowSummB + 1


       'Go back to "Summary by Component" tab to continue
        Sheets("Summary by Component").Select
    Wend

'Wend through Potential Buy Expense and Lease
    While Len(Range("P" & CStr(LSearchRowC)).Value) > 0

        'Select row in "Summary by Component" to copy
        Range("B" & CStr(LSearchRowC)).Select
        Selection.Copy

        'Paste selection into Component field on "Worksheet" tab
        Sheets("Worksheet").Select
        Range("B2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Range("B8").Select
        ActiveCell.FormulaR1C1 = "Potential Buy"

        'Copy Expense and Lease Totals and copy to "Summary by Component" tab
        Range("I1:T1").Select
        Selection.Copy
        Sheets("Summary by Component").Select
        Range("C" & CStr(LCopyToRowSummC)).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        LSearchRowC = LSearchRowC + 1
        LCopyToRowSummC = LCopyToRowSummC + 1


       'Go back to "Summary by Component" tab to continue
        Sheets("Summary by Component").Select
    Wend

'Wend through Potential Buy Capital
    While Len(Range("P" & CStr(LSearchRowD)).Value) > 0

        'Select row in "Summary by Component" to copy
        Range("B" & CStr(LSearchRowD)).Select
        Selection.Copy

        'Paste selection into Component field on "Worksheet" tab
        Sheets("Worksheet").Select
        Range("B2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        'Copy Expense and Lease Totals and copy to "Summary by Component" tab
        Range("I2:T2").Select
        Selection.Copy
        Sheets("Summary by Component").Select
        Range("C" & CStr(LCopyToRowSummD)).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        LSearchRowD = LSearchRowD + 1
        LCopyToRowSummD = LCopyToRowSummD + 1


       'Go back to "Summary by Component" tab to continue
        Sheets("Summary by Component").Select
    Wend

'======= End component updates =======

    Sheets("Worksheet").Select
    Range("B2").Select
    Selection.ClearContents
    Range("B8").Select
    Selection.ClearContents
    Range("A1").Select
    Sheets("Worksheet").Visible = False

    Sheets("Summary by Component").Select
    Range("A1").Select

'======= Clean up and go home =======
'Turn screen updating back on
    Application.ScreenUpdating = True

'Prompt the user that the updates are complete
MsgBox "The update is complete."

Answer 3

您应该使用单元格（1,1）而不是范围（“A1”）。您的代码将更快更容易阅读。您可以通过更改'of line：

来使用此简单代码对其进行测试

Sub test()
Dim starttime As Double
Dim s As String
Dim i As Long

starttime = Timer

    For i = 1 To 10 ^ 5
    s = Range("A1").Value
    's = Cells(1, 1).Value
    Next i

MsgBox Timer - starttime

End Sub

除此之外，如果您的代码正常工作，请保持原样。

Answer 4

谢谢你的帮助，@ celapointe。这是最终的代码：

    Sheets("Summary by Component").Select

    'Expense and Lease - Approved
    Dim i As Integer
    i = 9                       

    'Capital - Approved
    Dim j As Integer
    j = 35               

    'Expense and Lease - Potential Buy
    Dim k As Integer
    k = 62

    'Capital - Potential Buy
    Dim m As Integer
    m = 88

'Wend through Approved Expense and Lease
    While Cells(i, 2).Value <> ""

        Cells(i, 2).Select
        Selection.Copy

        Sheets("Worksheet").Select

        Cells(2, 2).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Cells(8, 2).Select
        ActiveCell.FormulaR1C1 = "Approved"

        Range(Cells(1, 9), Cells(1, 20)).Select ' Select I1:T1
        Selection.Copy
        Sheets("Summary by Component").Select
        Cells(i, 3).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


        i = i + 1

        Sheets("Summary by Component").Select
    Wend

'Wend through Approved Capital
    While Cells(j, 2).Value > 0

        Cells(j, 2).Select
        Selection.Copy

        Sheets("Worksheet").Select
        Cells(2, 2).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        Range(Cells(2, 9), Cells(2, 20)).Select ' Select I2:T2
        Selection.Copy
        Sheets("Summary by Component").Select
        Cells(j, 3).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        j = j + 1

        Sheets("Summary by Component").Select
    Wend

'Wend through Potential Buy Expense and Lease
    While Cells(k, 2).Value > 0

         Cells(k, 2).Select
         Selection.Copy

        Sheets("Worksheet").Select
        Cells(2, 2).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Cells(8, 2).Select
        ActiveCell.FormulaR1C1 = "Potential Buy"

        Range(Cells(1, 9), Cells(1, 20)).Select ' Select I1:T1
        Selection.Copy
        Sheets("Summary by Component").Select
        Cells(k, 3).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        k = k + 1

       Sheets("Summary by Component").Select
    Wend

'Wend through Potential Buy Capital
    While Cells(m, 2).Value > 0

        Cells(m, 2).Select
        Selection.Copy

        Sheets("Worksheet").Select
        Cells(2, 2).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        Range(Cells(2, 9), Cells(2, 20)).Select
        Selection.Copy
        Sheets("Summary by Component").Select
        Cells(m, 3).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        m = m + 1

        Sheets("Summary by Component").Select
    Wend