Thema Datum  Von Nutzer Rating
Antwort
Rot Loop statt 1000 If Funktionen
25.10.2021 14:48:51 Marvin
NotSolved
25.10.2021 17:33:13 Gast76559
NotSolved
25.10.2021 17:54:50 Mackie
NotSolved

Ansicht des Beitrags:
Von:
Marvin
Datum:
25.10.2021 14:48:51
Views:
134
Rating: Antwort:
  Ja
Thema:
Loop statt 1000 If Funktionen

Hallo liebe VBA Profis,
ich versuche ein Makro zu schreiben, welches eine weitere Zeile einfügt, solange in der vorherigen Zeile noch ein Wert berechnet wird. Dies ist mir so weit auch schon gelungen, allerdings kann es sein, dass bis zu 1000 weitere Zeilen eingefügt werden, weshalb meine derzeitige Vorgehensweise äußerst ineffizient ist. Ziel ist es, die folgenden If-Funktionen im Code über einen Loop darzustellen und mir 1000 weitere manuell geschriebene If-Funktionen zu sparen. Zum besseren Verständnis, was der Loop machen soll, habe ich die If-Funktionen 4 mal wiederholt. Kann mir jemand weiterhelfen?
 
Besten Dank,
 
Marvin

 

Private Sub Button_Ok_Click()
'Eingabe in die Arbeitsmappe übernehmen
'Arbeitsmappe leeren
    Range("A:A").Select
    Selection.ClearContents
        Rows("3:3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
 
ActiveSheet.Cells(2, 1).Value = Eingabefenster.TextBox_CS_Auftrag.Value
ActiveSheet.Cells(1, 1).Value = Eingabefenster.TextBox_CS_Auftrag.Value
ActiveSheet.Calculate
 
 
 
    ' wenn im feld Datum was drinsteht (also Spalte Q = True), dann eine extra Zeile nach unten einfügen
        If ActiveSheet.Cells(2, 17) = True Then
     
        ActiveSheet.Range("A2:Q2").Select
        Application.CutCopyMode = False
        Selection.AutoFill Destination:=Range("A2:Q3"), Type:=xlFillDefault
        ActiveSheet.Range("A2:Q3").Select
         
        Range("A1:A2").Select
        Selection.AutoFill Destination:=Range("A1:A3"), Type:=xlFillDefault
 
         
     
    Else
    End If
     If ActiveSheet.Cells(3, 17) = True Then
     
        ActiveSheet.Range("A2:Q2").Select
        Application.CutCopyMode = False
        Selection.AutoFill Destination:=Range("A2:Q4"), Type:=xlFillDefault
        ActiveSheet.Range("A2:Q4").Select
         
        Range("A1:A2").Select
        Selection.AutoFill Destination:=Range("A1:A4"), Type:=xlFillDefault
 
     
    Else
    End If
    If ActiveSheet.Cells(4, 17) = True Then
     
        ActiveSheet.Range("A2:Q2").Select
        Application.CutCopyMode = False
        Selection.AutoFill Destination:=Range("A2:Q5"), Type:=xlFillDefault
        ActiveSheet.Range("A2:Q5").Select
         
        Range("A1:A2").Select
        Selection.AutoFill Destination:=Range("A1:A5"), Type:=xlFillDefault
 
     
    Else
    End If
    If ActiveSheet.Cells(5, 17) = True Then
     
        ActiveSheet.Range("A2:Q2").Select
        Application.CutCopyMode = False
        Selection.AutoFill Destination:=Range("A2:Q6"), Type:=xlFillDefault
        ActiveSheet.Range("A2:Q6").Select
         
        Range("A1:A2").Select
        Selection.AutoFill Destination:=Range("A1:A6"), Type:=xlFillDefault
 
     
    Else
    End If
 
 
Unload Eingabefenster
 
End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Loop statt 1000 If Funktionen
25.10.2021 14:48:51 Marvin
NotSolved
25.10.2021 17:33:13 Gast76559
NotSolved
25.10.2021 17:54:50 Mackie
NotSolved