Bu küçük VBA kodunu biraz daha küçültmek için nasıl kısaltabilirim?

Çok büyük hatalarını aldığım numaralı yordamı aldığım noktaya ulaştım ve bu benim kodumun çok bozuk olmasından kaynaklanıyor. Söz konusu bölüm şöyle:Bu küçük VBA kodunu biraz daha küçültmek için nasıl kısaltabilirim?

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

Bu devam eder ve patientsperrespondentpertimepoint 12 kadar 4 ila 5 tüm yolu 3 ila birer birer büyür, ve karşılık gelen bir kopyalama ve yapıştırma komutu her adımda en eklenir merdiven. Sorum şu, bunu nasıl kısaltabilirim? Tekrarlanan bir çok kod var, bu yüzden daha kısa ve daha şık bir çizme yapmanın bir yolunu bulabilir miyim diye merak ediyorum. Teşekkürler!

kaynak

2016-04-04 sarcasm24

Yapı bir işlevi yoktur yapılmış olabilir biraz daha optimizasyonlar vardır, ama bu size kod daha özlü kılan bir fikir verir? Ancak bu, kod incelemesi için daha uygundur. – findwindow

[Bundan böyle Excel VBA makrolarında seçme nasıl kullanılır] (http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros) güvenerek hedeflerinizi gerçekleştirmek için seçin ve etkinleştirin. – Jeeped

[Nasıl yapılır? 'Nasıl yapılır?] [Http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros] aracılığıyla okuyun, bu size oldukça uzak olacak . – 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

kaynak

2016-04-04 20:21:14 GSerg

Bu mükemmel çalışır. Yüzlerce satırlık satırı 5 satır ile değiştirmek gerçekten etkileyici. Teşekkürler! – sarcasm24

Güzel çözüm. Çalışma sayfaları için referans değişkenleri oluşturarak ve ayrıca Aralığı (...) yerine Hedef aralığına daha doğrudan başvurmak için Cells yöntemini kullanarak performanstan kaçınabilirsiniz. – ThunderFrame

Bunu deneyin. ...

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

kaynak

2016-04-04 20:19:52 ThunderFrame

Bu küçük VBA kodunu biraz daha küçültmek için nasıl kısaltabilirim?

cevap

İlgili konular