VBA: Wie kann ich den Code kürzen?

...komplette Frage anzeigen

3 Antworten

Ich konzentriere mich mal auf die Stelle mit den Pünktchen. Um die geht es dir ja.

  1. Statt "If gl = True" reicht "If gl"
  2. Du kannst alle If gl-Abfragen in einen Block zusammenfassen: 

    If gl Then
     '...
    End If
  3. Das Else kannst du, wie geri3d schreibt, sparen, da du jeweils eine Zelle auf sich selbst abbildest.
  4. Du zählst beim Zuweisen immer um 1 hoch, also kannst du eine Schleife benutzen.

    For i=6 To 150
      Sheets(1).Cells(i,18).Value = Sheets(5).Cells(i-4,40).Value
    Next

Zusatzhinweis: Auf Application.EnableEvents = False sollte immer ein On Error GoTo folgen, damit sichergestellt ist, dass Excel nicht lahm gelegt wird.



Vielen Dank, super Erklärung! bin auf das i-4 nicht selbst gekommen, scheint aber einwandfrei zu funktionieren.

Ich habe jetzt noch "On Error GoTo Fehler" eingefügt und eine Message Box eingefügt. Leider kommt die jetzt bei jedem Durchlauf und nicht nur wenn er den Kopiervorgang nicht durchführt.

Wo liegt da der Fehler ?

 

    If gl Then
        For i = 6 To 150
            Sheets(1).Cells(i, 18).Value = Sheets(5).Cells(i - 4, 40).Value
        Next
    End If
     
   Application.EnableEvents = True
   Application.ScreenUpdating = True
 On Error GoTo Fehler
Fehler:
   MsgBox "Error"
0
@molekuelx

Vor "Fehler:" würde ich mit "Exit Sub" aus der Prozedur aussteigen.

On Error GoTo Fehler sollte hinter ...EnableEvents = False stehen, also oben, nicht nach dem Aktivieren.

Unter der MsgBox solltest du die Fehlerbehandlung wieder ausstellen: On Error GoTo 0

Nochmal zusammengefasst:

Application.EnableEvents = False
On Error GoTo Fehler
'...
Application.EnableEvents = True
On Error GoTo 0
Exit Sub
Fehler:
Application.EnableEvents = True
MsgBox "Fehler"
On Error GoTo 0

Ohne Meldung wäre es einfacher:

Application.EnableEvents = False
On Error GoTo Fehler
'...
Fehler:
Application.EnableEvents = True
On Error GoTo 0

(alles ungetestet)

2
@molekuelx

Da kommt die Meldung wahrscheinlich trotzdem.  vllt:

if Err() <> 0 then Msgbox"Fehler "& Err()

?

Im übrigen finde ich die unterschiedliche Verwertung von i in unseren beiden Antworten interessant! Es führen wieder mal viele Wege nach Rom! (als i-4 würde der Bezug zu offset(-4, ...) offensichtlich!)

1
@Suboptimierer

Danke für die hilfreichen Beiträge! Das hilft mir sehr dabei, VBA Stück für Stück besser zu verstehen und zu lernen! Habe die Fehlermeldung erfolfreich eingebaut :-)

Zwei kleine Punkte sind jedoch noch offen und wollen einfach nicht funktionieren.

1. Der Komplette vergleich mit anschließendem kopieren und einfügen soll nur erfolgen, wenn ein Button angeklickt wird. Dazu habe ich ein Formularsteuerelement eingefügt (bei ActiveX kommt immer eine Fehlermeldung) und habe der Schaltfläche das Makro zu gewiesen. Das funktioniert auch prima! Jedoch löst das Makro auch vor einem Rechtsklick aus (da Code von Tabelle 1 und 2 so eingestellt ist " Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)"

---> Welches Ereigniss muss ich verwenden, damit das Makro nur vom Formularsteuerelement ausgelößt wird, und nicht bei change oder beforrightklick etc ... ?

 

2. Zudem soll nur in Tabelle 1 ein zusätzlicher Befehl ausgeführt werden, wenn der Status kopiert und eingefügt wird. (also nicht bei gl=False sondern nur bei If gl then)

Wenn ich den unten stehenden Code jedoch hinzufüg kommt zwar keine Fehlermeldung, es passiert aber auch nichts.

Der Code der in der Tabelle 1 schon steht ist folgender:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  Call DieseArbeitsmappe.vergleich
End Sub

Der Code der in Tabelle 1 ergänzt werden soll ist dieser:

Private Sub Worksheet_Change(ByVal Target As Range)
  'Abfrage, ob Änderung in Spalte R erfolgt ist
  Dim i As Integer
  For i = 6 To 150
    If Target.Address = "$R$" & i Then
        If Target.Value = "STATUS1=grün" Then
            Range("I" & i & ":J" & i).ClearContents
            Range("L" & i & ":N" & i).ClearContents
        End If
        If Target.Value = "STATUS2=gelb" Then
            Range("I" & i & ":J" & i).ClearContents
        End If
    End If
  Next
End Sub

 

Danke für die Unterstützung!!!

0
@molekuelx

1) Leg ein Modul an (Einfügen → Modul). Leg dort eine Prozedur an (Sub Vergleich()). Weis dem Formularsteuerelement "Schaltfläche" das Makro "Vergleich" zu (rechte Maustaste → Makro zuweisen...). Kopier den Code in die Prozedur Vergleich.

Es werden noch Anpassungen fällig sein. Du hast kein Zugriff mehr auf Target und musst manuell die Bezugszelle festlegen.
Es kann sein, dass du das Sheet, auf das du dich beziehst, vor jedem Range-Befehl explizit angeben musst.

2) 

If gl Then
  ' Zusätzlicher Befehl
End If
0
@Suboptimierer

Habe jetzt die ganze "Prozedur" in einem Modul1 abgelegt und den Code schnippsel zusätzlich eingefügt.

Jetzt bringt er aber: "Fehler beim Kompilieren: Mehrfachdeklaration im aktuellen Gültigkeitsbereich" und verweist auf den Befehel: "Dim i As Integer"

Habe gegoogelt, finde bei mir aber nur diese Deklaration einmal und nicht doppelt?

Das Ende des Codes im Modul sieht jetzt so aus:

...
         If (c2 = True) Then
            gl = False
            Sheets(5).Cells(ze2, sp2).Interior.Color = RGB(0, 255, 255)
         Else
            Sheets(5).Cells(ze2, sp2).Interior.Color = xlNone
         End If
              
      Next
   Next
  
    If gl Then
        For i = 6 To 150
            Sheets(1).Cells(i, 18).Value = Sheets(5).Cells(i - 4, 40).Value
            Sheets(1).Cells(i, 17).Value = Sheets(5).Cells(i - 4, 23).Value
            Sheets(1).Cells(i, 16).Value = Sheets(5).Cells(i - 4, 25).Value
        Next
    End If
     
     
    If gl Then
   
    Dim i As Integer
    For i = 6 To 150
    If Target.Address = "$R$" & i Then
        If Target.Value = "STATUS1=grün" Then
            Range("I" & i & ":J" & i).ClearContents
            Range("L" & i & ":N" & i).ClearContents
        End If
        If Target.Value = "STATUS2=gelb" Then
            Range("I" & i & ":J" & i).ClearContents
        End If
    End If
  End If
       
       
   Application.EnableEvents = True
   Application.ScreenUpdating = True
End Sub

Der Code der bei Tabelle 1 und 5 hinterlegt ist, ist aber immer noch gleich:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  Call DieseArbeitsmappe.vergleich
End Sub

Müsste man dort nicht etwas wegen dem BeforeRightClick ändern?

 

 

0
@molekuelx

Ich sehe auch nur einmal Dim i. i wird jedoch davor schon verwendet. Du solltest die Deklarationen an den Anfang der Prozedur stellen. Was steht denn bei ...?

If gl Then   
    Dim i As Integer
    For i = 6 To 150
0
@Suboptimierer
Sub vergleich()
   Application.EnableEvents = False
   Application.ScreenUpdating = False
 
   gl = True
  
   For sp = 0 To 4
      sp1 = 3 + sp
      sp2 = 4 + sp
      For ze = 0 To 148
         ze1 = 6 + ze
         ze2 = 2 + ze
        
         v1 = Sheets(1).Cells(ze1, sp1)
         v2 = Sheets(5).Cells(ze2, sp2)
        
         c1 = True
         c2 = True
     
         If (v1 = v2) Then
            c1 = False
            c2 = False
         End If
     
         If (v1 = "") Then
            c1 = False
         End If
        
         If (v2 = "") Then
            c2 = False
         End If
        
         If (c1 = True) Then
            gl = False
            Sheets(1).Cells(ze1, sp1).Interior.Color = RGB(0, 255, 255)
            MsgBox "ERROR: Status Abgleich Fehlgeschlagen."
         Else
            Sheets(1).Cells(ze1, sp1).Interior.Color = xlNone
         End If
 
         If (c2 = True) Then
            gl = False
            Sheets(5).Cells(ze2, sp2).Interior.Color = RGB(0, 255, 255)
         Else
            Sheets(5).Cells(ze2, sp2).Interior.Color = xlNone
         End If
              
      Next
   Next
  
    If gl Then
        For i = 6 To 150
            Sheets(1).Cells(i, 18).Value = Sheets(5).Cells(i - 4, 40).Value
            Sheets(1).Cells(i, 17).Value = Sheets(5).Cells(i - 4, 23).Value
            Sheets(1).Cells(i, 16).Value = Sheets(5).Cells(i - 4, 25).Value
        Next
    End If
     
     
    If gl Then
   
    Dim i As Integer
    For i = 6 To 150
    If Target.Address = "$R$" & i Then
        If Target.Value = "STATUS1=grün" Then
            Range("I" & i & ":J" & i).ClearContents
            Range("L" & i & ":N" & i).ClearContents
        End If
        If Target.Value = "STATUS2=gelb" Then
            Range("I" & i & ":J" & i).ClearContents
        End If
    End If
  End If
       
       
   Application.EnableEvents = True
   Application.ScreenUpdating = True
End Sub

 

Das ist der komplette Code im Modul1

0
@molekuelx

Dim i muss an den Anfang. Es darf keine zweite Prozedur namens "Vergleich" geben.

Schreibe oben, in die allererste Zeile (außerhalb der Prozeduren) "Option Explicit". Das sollte deine Fehlersuche erleichtern.

0
@Suboptimierer

Habe das so abgeändert. Jetzt meldet er: "Fehler beim Kompilieren: Variable nicht definiert" und verweist auf gl=True ganz am anfang der Prozedur.

Seltsam, das es ja bis dato den Code nicht gestrört hatte

0
@molekuelx

Ja, genau das bewirkt Option Explicit. So wird dein Quellcode sauberer. Schreibe am Anfang der Prozedur Dim gl As Boolean und verfahre mit den folgenden Fehlern genau so.

0
@Suboptimierer

Danke für deine Geduld! Ich steige langsam durch :-) 

Ich bin jedoch noch unsicher, als was ich Target deklarieren soll? Habe provisorisch mal "Dim Target As Action" eingefügt, dass er nicht mehr meckert.

--> Beim Ausführen kommt jetzt "Laufzeitfehler 13: Typen unverträglichkeit" und er verweist auf v1=Sheets(1).Cells(ze1, sp1)

Ich gehe davon aus, dass er mit dem "Ziel" bzw. Target nicht weis was er anfangen soll, kann das sein?

Sub vergleich()
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim i As Integer
Dim gl As Boolean

Dim sp As Integer
Dim sp1 As Integer
Dim sp2 As Integer

Dim ze As Integer
Dim ze1 As Integer
Dim ze2 As Integer

Dim c1 As Boolean
Dim c2 As Boolean

Dim v1 As Integer
Dim v2 As Integer

Dim Target As Action


gl = True

For sp = 0 To 4
sp1 = 3 + sp
sp2 = 4 + sp
For ze = 0 To 148
ze1 = 6 + ze
ze2 = 2 + ze

v1 = Sheets(1).Cells(ze1, sp1)
v2 = Sheets(5).Cells(ze2, sp2)

c1 = True
c2 = True

If (v1 = v2) Then
c1 = False
c2 = False
End If

If (v1 = "") Then
c1 = False
End If

If (v2 = "") Then
c2 = False
End If

If (c1 = True) Then
gl = False
Sheets(1).Cells(ze1, sp1).Interior.Color = RGB(0, 255, 255)
MsgBox "ERROR: Fehler."
Else
Sheets(1).Cells(ze1, sp1).Interior.Color = xlNone
End If

If (c2 = True) Then
gl = False
Sheets(5).Cells(ze2, sp2).Interior.Color = RGB(0, 255, 255)
Else
Sheets(5).Cells(ze2, sp2).Interior.Color = xlNone
End If

Next
Next

If gl Then
For i = 6 To 150
Sheets(1).Cells(i, 18).Value = Sheets(5).Cells(i - 4, 40).Value
Sheets(1).Cells(i, 17).Value = Sheets(5).Cells(i - 4, 23).Value
Sheets(1).Cells(i, 16).Value = Sheets(5).Cells(i - 4, 25).Value
Next
End If

If gl Then
For i = 6 To 150
If Target.Address = "$R$" & i Then
If Target.Value = "STATUS1=grün" Then
Range("I" & i & ":J" & i).ClearContents
Range("L" & i & ":N" & i).ClearContents
End If
If Target.Value = "STATUS2=gelb" Then
Range("I" & i & ":J" & i).ClearContents
End If

End If

Application.EnableEvents = True
Application.ScreenUpdating = True

Next
End If
End Sub
0
@molekuelx

Target, v1 und v2 sind vom Typ Range. Target würde ich umbenennen, um nicht Verwirrung zu stiften, denn Target wird üblicherweise als Name für den Übergabeparameter eines Ereignisses verwendet.

Benenn deine Variablen allgemein sprechender. Aus dem Namen sollte der Typ bereits hervor gehen. Statt sp iSpalte (i=Integer), statt ze iZeile, ...

Du bekommst Target nicht mehr übergeben. Du musst die Zelle selbst zuordnen.

0
@molekuelx

Sorry schnelle korrektur: Habe v1 und v2 als string deklariert und jetzt geht es :-)

Jedoch passt das mit dem Target tatsächlich nicht. Er meldet den Fehler 91: Objektvariable oder With-Blockvariable nicht festgelegt.

und markiert " If Target.Address = "$R$" & i Then"

0
@molekuelx

Du hast nicht festgelegt, auf welche Zelle sich Target bezieht → Beispiel: Set Target = Sheets(1).Range("R8")

0
@Suboptimierer

Habe das so eingefügt (Set Target = Sheets(1).Range("R6")), dann funktioniert das auch für R6 ...

Target ist ja aber eigentlich der ganze bereich R6:R150 nur bei folgendem Befehl tut er gar nichts:

Set Target = Sheets(1).Range("R6:R150")

und das Problem mit dem Rechtsklick bleibt bestehen da Tabelle 1 und Tabellle 5 den Code enthält:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Call DieseArbeitsmappe.vergleich
End Sub
0
@molekuelx

Wenn das Target für einen Bereich gelten soll, musst du jede Zelle des Bereichs in einer Schleife durchwandern:

For Each Target in Sheets(1).Range("R6:R150")
  '...
Next

Das mit dem Rechtsklick brauchst du doch gar nicht mehr, oder? Den Code kannst du löschen. Du löst doch jetzt per Klick auf den Button aus.

0
@Suboptimierer

Ok habe die Targetschleife eingefügt, es funktioniert auch aber er führt schon seit 2 Minuten das Makro aus und ist noch nicht fertig :D 

0
@molekuelx
For i = 6 To 150

Das brauchst du nicht mehr. Ersetz das durch i = Target.Row oder andersherum brauchst du die For Each Schleife nicht mehr, wenn du nach For i = 6 To 150 schreibst: Set Target = Sheets(1).Range("R" & i)

Viele Wege führen nach Rom.

0
@Suboptimierer

Super, jetzt braucht er "nur" noch 20 Sekunden! Das ist jedoch akzeptabel auch wenn es etwas "blinkt" und "zuckt".

Vielen Dank für deine Mühe und deine Zeit! Habe eigenständig und erfolgreich noch abschließend eine "Fehlermeldung" bei gl=False und eine "Erfolgsmeldung" bei gl=True eingefügt. Funktioniert prima und habe das konzept geschnallt :-)

1
@Suboptimierer

Habe mit einem anderen (ähnlichen) Modul noch ein winziges Problem. Das Knackpunkt liegt nur bei ze2 ... ich finde aber ums verrecken nicht den richtigen Weg. Es funktioniert eigentlich genau so wie es soll. Jedoch soll in Sheet(2).Cells(ze2, sp3).Value der Bereich quasi ab Zeile 6 aufgefüllt werden. Im Moment kopiert er das was in Sheet1 in Zeile 40 steht in Sheet2 in Zeile 40 (da ze1=ze2) er soll aber in Sheet2 ab Zeile 6 reinkopieren und dann quasi auffüllen.

--> Kopiere in Sheet2 Zeile6 das erste "Teil". Das zweite gefundene Teil (z.B. "STATUS3=rot") soll er dann in der nächst freien Zeile kopieren also Zeile 7.

Ich hoffe es ist verständlich. Ich vermute es ist sehr einfach zu lößen in dem man ze2 anderes festlegt. Bin jedoch sehr zufrieden mit meiner Eigenleistung ;-) Aller Anfang ist schwer ...

Hier der Code um den es geht:

Option Explicit
Sub vergleich()
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim sp As Integer
Dim sp1 As Integer
Dim sp2 As Integer
Dim sp3 As Integer

Dim ze As Integer
Dim ze1 As Integer
Dim ze2 As Integer

Dim v1 As String
Dim v2 As String
Dim v3 As String

Dim Target As Range

For Each Target In Sheets(1).Range("R6:R150")

For sp = 0 To 4
sp1 = 3 + sp
sp2 = 11 + sp
sp3 = 17 + sp

For ze = 0 To 148
ze1 = 6 + ze
ze2 = 1 + ze

v1 = Sheets(1).Cells(ze1, sp1)
v2 = Sheets(2).Cells(ze2, sp2)
v3 = Sheets(1).Cells(ze1, 35)

If (v3 = "STATUS2=gelb") Then
Sheets(2).Cells(ze2, sp3).Value = Sheets(1).Cells(ze1, sp1).Value
Sheets(2).Cells(ze2, 21).Value = Sheets(1).Cells(ze1, 34).Value
End If

If (v3 = "STATUS3=rot") Then
Sheets(2).Cells(ze2, sp2).Value = Sheets(1).Cells(ze1, sp1).Value
Sheets(2).Cells(ze2, 15).Value = Sheets(1).Cells(ze1, 34).Value
End If
Next
Next
Next
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
0
@molekuelx

Warum der ab Zeile 40 anfängt, sehe ich nicht, aber dein For Each Target ist hier überflüssig. Du verwendest Target innerhalb der Schleife gar nicht. Andere Variablen werden auch innerhalb der For-Each-Schleife initialisiert.

Kannst du nicht einfach die Copy-Methode zum Kopieren von Zellbereichen verwenden?

Kein Wunder, dass man da schwer durch blickt, bei so vielen Variablen.

0
@molekuelx

Achso, du kopierst selektiv.

Da man meistens Zeilen kopieren will, solltest du über die Zeilen in der äußeren Schleife iterieren, über die Spalten in der inneren. Ich müsste es mir genauer anschauen, aber evtl. könntest du dir die Iteration über die Spalten sparen, indem du komplette Zeilen mit Copy kopierst.

0
@Suboptimierer

Das mit Zeile 40 war nur ein Beispiel :P Er tut eigentlich genau schon das war er soll ... nur er lässt in Sheet 2 zwischen den kopierten Zellen (Zeilen) immer genau so viele Platz wie auch in Sheet1 zwischen den Zeilen ist.

Bsp.: Das erste Teil (was in Sheet1 Spalte R den Inhalt: "STATUS3=rot") enthälllt soll er in Sheet2 (6 , sp2) kopieren. Also wenn das Teil in Sheet1 in Zeile bsp. 25 Steht soll er es in Sheet 2 in Zeile 6 einfügen. Das nächste Teil was er bsp. in Sheet1 Zeile 38 findet ("STATUS3=rot") soll er in Sheet2 dementsprechen in die nächste leer Zeile kopieren, also Sheet2 (7, sp2) 

Die Spalten stimmen schon Perfekt! Nur die Zeilen passen nicht.

0
@molekuelx

Puh, du verstehst sicherlich, wenn das mir jetzt zu aufwändig ist, für dich alles umzuschreiben. Ich kann dir aber helfen, indem ich dir den Weg skizziere:

  • Lauf über alle Zeilen zeQuelle in der Quelltabelle
  • Setze dir einen Merker zeZiel1 auf die erste Zeile der Zieltabelle1, zeZiel2 für Zieltabelle2 usw.
  • Immer wenn nach zeZiel1 kopiert wurde, inkrementierst du zeZiel1 (zeZiel2 usw. entsprechend, wenn jene Tabellen zum Ziel werden)
  • Genauso verfährst du mit den Spalten (wenn du nicht die Zeilen in einem Rutsch mit Copy kopieren willst)
  • Wie gesagt empfehle ich, die äußere Schleife über die Zeilen laufen zu lassen. Das ist einfach üblich, da man pro Zeile von links nach rechts liest und nicht pro Spalte von oben nach unten. Wir sind doch keine Chinesen. ^^
0
dim i '(nicht essentiell: As Integer, das oben noch einfügen, sowie:) 
On Error Goto NormalZustandWiederHerstellen
'...
If gl = True Then
For i = 1 to 243
Sheets(1).Cells(i+5, 18) = Sheets(5).Cells(i+1, 40)
next
Else Sheets(1).Cells(i+5, 18) = Sheets(1).Cells(i+5, 18) 'kann genausogut fehlen, ändert ja nix, oder setzt du da eine Formel zu Wert um?
End if
'...Spar Dir übrigens nicht das Standardargument .value, du siehst, dass es zu Unsicherheiten führt, wenn es fehlt (könnte ja auch mal .formula oder formulalocal gemeint sein oder Anderes
'vor Appl. Enable usw unbedingt noch einfügen: (der : bedeutet Zeilenmarke!)

NormalZustandWiederHerstellen
:


stelle auch die Option Explicit ein und melde alle Variablen per dim an, dieser kleine Aufwand erleichtert die Fehlerursachen zu finden enorm! Das jeweilige As ... braucht VBA bei den heutigen Kapazitäten nicht mehr, da wird eben dann eine max. Variable angemeldet und dafür der Speicherplatz reserviert.

Objekte musst Du dann per Set definieren, Matritzen als dim Mtx() voranmelden  und dann als Einsatz als redim Mtx(3, 4) als  hier zB 12-Item-Matrix festlegen.

Für eine Inputbox, die Adressen-Eingaben verarbeiten soll (muss meist nicht als Matrix angemeldet werden, weil VBA das ja als Bereich versteht, der schon im Blatt angelegt, also vorhanden ist und nur ausgewählt werden muss):

Set FeldA = inputbox(...........;8) -Typ wählen und alle ; setzen

(das waren die Hürden, die mich seinerzeit am meisten Zeit gekostet haben und dabei ganz einfach zu überwinden sind, wenn man weiß, wie!)

0
@Iamiam

drittletzte Zeile: Kann sogar sein, dass da noch ein Application. vor das Inputbox muss, das kann ich mir nie merken, wann das rein muss und wann nicht (zB bei Application.Worksheetfunction zB muss es rein! in anderen Fällen kanns überflüssig oder sogar störend sein!)

0
@Iamiam

Ich hatte schon ähnliche Phänomene, kann dieses aber momentan nicht nachvollziehen.

Sowohl Prozeduren direkt am Sheet als auch die eines Moduls lassen sich ohne Application-Präfix ausführen:

Sheet:

Sub ApplicationTest1()
  Sheets(1).Range("D1").Value = WorksheetFunction.Max(1, 5, 3)
End Sub

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$D$1" Then _ Sheets(1).Range("D1").Value = WorksheetFunction.Max(2, 6, 4) End Sub

Modul:

Sub ApplicationTest2()
  Sheets(1).Range("D1").Value = WorksheetFunction.Max(3, 7, 9)
End Sub
1

Über den Else-Zweig kann man sich streiten. Das schreit nach einer For Schleife. Ich bin mir nicht ganz klar wie das mit dem Offset ist.

 If gl = True Then Sheets(1).Cells(6, 18) = Sheets(5).Cells(2, 40) Else Sheets(1).Cells(6, 18) = Sheets(1).Cells(6, 18)

Ich will dir das jetzt nicht im code vorkauen, eine Forschleife solltest du schon noch zustande bringen.

Sagen wir es doch einmal, wie es ist. Der Else-Zweig ist sinnlos. Er weist einer Zelle den Wert zu, den sie sowieso schon trägt.

Else Sheets(1).Cells(6, 18) = Sheets(1).Cells(6, 18)
1
@Suboptimierer

Ja das ist vollkommen richtig :D das war meine Lösung dafür, dass dann einfach nichts passieren soll ... ich wusste nur nicht wie ich das formulieren muss / kann

0

Ich dachte mir auch, dass eine For Schleife die richtig lösung ist. Da der Befehl aber Sheet 1 und Sheet 5 beihalted, bin ich mir unsicher wie ich dem Bezug setze.

Wäre das so zu lößen?

Ich bin leider gerade erst dabei mir VBA beizubringen und versuche stück für stück zu verstehen, wie die Codes funktionieren.


Dim intRow As Integer<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" />

 

   For intRow = 6 To 150

   For intRow = 2 To 148

          If gl = True Then Sheets(1).Cells(6, 18) = Sheets(5).Cells(2, 40) Else Sheets(1).Cells(6, 18) = Sheets(1).Cells(6, 18)  

 

Next intRow

 

0
@molekuelx

Denk mal logisch. Nur wenn g1=true ansonsten brauchst du nicht mal die schleife also strukturiere deine logik um.

0

Was möchtest Du wissen?