Wie kann ich dieses spezielle Bit des VBA-Codes verkürzen, um es kleiner zu machen?

Ich habe den Punkt erreicht, wo ich eine Prozedur zu groß Fehler erhalte, und es ist, weil mein Code sehr klobig ist. Der Abschnitt in Frage folgt:Wie kann ich dieses spezielle Bit des VBA-Codes verkürzen, um es kleiner zu machen?

If patientsperrespondentpertimepoint = 1 Then 
Sheets("Work").Select 
Range("D2:D" & patientprofiles + 1).Select 
Selection.Copy 
Sheets("Output").Select 
Range("B2").Select 
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
    False, Transpose:=True 
ElseIf patientsperrespondentpertimepoint = 2 Then 
Sheets("Work").Select 
Range("D2:D" & patientprofiles + 1).Select 
Selection.Copy 
Sheets("Output").Select 
Range("B2").Select 
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
    False, Transpose:=True 
Sheets("Work").Select 
Range("D" & patientprofiles + 2 & ":D" & 2 * patientprofiles + 1).Select 
Selection.Copy 
Sheets("Output").Select 
Range("B3").Select 
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
    False, Transpose:=True 
ElseIf patientsperrespondentpertimepoint = 3 Then 
Sheets("Work").Select 
Range("D2:D" & patientprofiles + 1).Select 
Selection.Copy 
Sheets("Output").Select 
Range("B2").Select 
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
    False, Transpose:=True 
Sheets("Work").Select 
Range("D" & patientprofiles + 2 & ":D" & 2 * patientprofiles + 1).Select 
Selection.Copy 
Sheets("Output").Select 
Range("B3").Select 
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
    False, Transpose:=True 
Sheets("Work").Select 
Range("D" & 2 * patientprofiles + 2 & ":D" & 3 * patientprofiles + 1).Select 
Selection.Copy 
Sheets("Output").Select 
Range("B4").Select 
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
    False, Transpose:=True

Dies setzt sich fort, und patientsperrespondentpertimepoint wächst eine nach der anderen von 3 bis 4 zu 5 All dem Weg bis zu 12, und ein entsprechendes Kopieren und Einfügen-Befehl wird an jedem Schritt hinzugefügt von die Leiter. Meine Frage ist, wie kann ich das verkürzen? Da sich eine Menge Code wiederholt, frage ich mich, ob ich einen Weg finden kann, ihn kürzer und eleganter zu machen. Vielen Dank!

Quelle

2016-04-04 sarcasm24

Erstellen Sie eine Funktion? aber das ist besser für die Code-Überprüfung geeignet. – findwindow

Siehe [So vermeiden Sie die Verwendung von Select in Excel VBA-Makros] (http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros) für Methoden, um wegzukommen Verlassen Sie sich auf auswählen und aktivieren Sie Ihre Ziele zu erreichen. – Jeeped

Lesen Sie durch [wie zu vermeiden '.Select'] (http://StackOverflow.com/questions/10714251/wie-zumAusweichen-use-select-in-excel-vba-macros), dies wird Sie ziemlich weit bringen . – BruceWayne

Dim i As Long 
For i = 0 To patientsperrespondentpertimepoint - 1 
    Worksheets("Work").Range("D" & (i * patientprofiles + 2) & ":D" & ((i + 1) * patientprofiles + 1)).Copy 
    Worksheets("Output").Range("B2").Offset(i, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True 
Next

Quelle

2016-04-04 20:21:14 GSerg

Das funktioniert perfekt. Wirklich beeindruckend, Hunderte von Codezeilen durch 5 Zeilen zu ersetzen. Vielen Dank! – sarcasm24

Schöne Lösung. Sie könnten etwas Leistung erzielen, indem Sie Referenzvariablen für die Arbeitsblätter erstellen und die Methode Cells verwenden, um direkt auf den Zielbereich zu verweisen, anstatt auf Bereich (...). Offset (...) – ThunderFrame

Versuchen Sie dies. Es gibt einige weitere Optimierungen, die gemacht werden können, aber das gibt Ihnen eine Vorstellung davon, was macht Code prägnanter ...

Sub Foo() 

    Dim shtWork As Worksheet 
    Dim shtOut As Worksheet 

    'I've qualified the workbook as ThisWorkbook, but you might want to be more specific if the sheets are in a different workbook 
    Set shtWork = ThisWorkbook.Sheets("Work") 
    Set shtOutput = ThisWorkbook.Sheets("Output") 

    If patientsperrespondentpertimepoint = 1 Then 
    shtWork.Range("D2:D" & patientprofiles + 1).Copy 
    shtOut.Range("B2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    ElseIf patientsperrespondentpertimepoint = 2 Then 
    shtWork.Range("D2:D" & patientprofiles + 1).Copy 
    shtOut.Range("B2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    shtWork.Range("D" & patientprofiles + 2 & ":D" & 2 * patientprofiles + 1).Copy 
    shtOut.Range("B3").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    ElseIf patientsperrespondentpertimepoint = 3 Then 
    shtWork.Range("D2:D" & patientprofiles + 1).Copy 
    shtOut.Range("B2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    shtWork.Range("D" & patientprofiles + 2 & ":D" & 2 * patientprofiles + 1).Copy 
    shtOut.Range("B3").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    shtWork.Range("D" & 2 * patientprofiles + 2 & ":D" & 3 * patientprofiles + 1).Copy 
    shtOut.Range("B4").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    'I've added a closing 'End If here 
    End If 

End Sub

Quelle

2016-04-04 20:19:52 ThunderFrame

Wie kann ich dieses spezielle Bit des VBA-Codes verkürzen, um es kleiner zu machen?

Antwort

Verwandte Themen