Schleife durch den Bereich, Wert in einem separaten Arbeitsblatt finden, Werte kopieren und zurückgeben und einfügen

Question

Ich habe ein aufgezeichnetes Makro, das ich intelligenter und wartungsfrei machen möchte. Das Makro ist sehr spezifisch darin, dass die Adressen und Werte der Zellen fest codiert sind. Wenn sich die Werteliste ändert, muss der Makrocode bearbeitet werden. Kein Problem für mich, aber zukünftige Benutzer werden wahrscheinlich nicht das Wissen oder die Neigung haben, es zu tun.

Ich denke, eine Schleife wäre die beste Lösung, aber ich bin mir nicht sicher, wie es weitergehen soll.

Hier ist die aktuelle Version des Codes:

'======= 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 

Bild von Flow: Flow

Answer 1

Sie sollten Zellen (1,1) anstelle des Bereichs („A1“) verwenden. Ihr Code wird schneller und einfacher zu lesen sein. Sie können es mit diesem einfachen Code testen, indem Sie die "der Linie zu ändern:

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 

Other than that, wenn Ihr Code funktioniert, lassen Sie es so.

Answer 2

Sie haben mehr Details geben: „Wenn die Liste der Werte ändert, dann wird der Makrocode muss bearbeitet werden "

Was sind die Änderungen in der Werteliste? Änderung von Zellen Wert oder Bereich? Was ist das Kriterium?

Ihr Problem scheint einfach mit Loops zu verwalten. Sie haben eine einfache Erklärung, wie es hier funktioniert: http://www.excel-pratique.com/en/vba/loops.php

EDIT

Sie müssen möglicherweise einige Änderungen vornehmen, wie ich die genaue Sache nicht sicher bin, Sie Ihren Code tun möchten, sondern versuchen, mit etwas wie diesem:

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 3

Hier ist, was ich mit kam. Ich bin sicher, dass es enger sein könnte, so dass alle Vorschläge sehr geschätzt:

' 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 4

Vielen Dank für Ihre Hilfe, @celapointe. Dies ist der endgültige Code:

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