Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1944to1948
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Visual Basic Fehler beim Kompilieren: Prozedur ist zu groß

Visual Basic Fehler beim Kompilieren: Prozedur ist zu groß
11.09.2023 13:28:25
Clamsy
Hallo,

ich bin jetzt kein Profi in VBA, aber ich habe ein Problem. Sicherlich gibt es einen Trick, wie man meinen VB Code verkleinern kann, damit es mit dem Kompilieren wieder klappt. Ich habe schon gegoogelt, aber ich werde nicht fündig weil ich nicht weiß wonach ich schauen muss.

Ich habe für die Spalte F und G und den jeweiligen Zeilen jeweils ein VB Code, jetzt müsste ich das noch für die Spalten J, K, N, O, R, S, V und W machen. Aber bereits beim J und K erweitern stoße ich an die Grenze.

Das VB macht, wenn z.B. in der F3 etwas eingetragen wird - nichts. Wird der Inhalt der F3 wieder gelöscht, wird eine vordefinierte Formel in die Zelle geschrieben. Das ganze soll je einzelner Zelle funktionieren, was es mit meiner Programmierung macht.

Es soll nicht, wenn ich in F3 etwas lösche eine Zelle F6 oder G8 oder so mit der Formel befüllen.

Hier mein Code-Snippet:



Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False ' Ereignisse vorübergehend deaktivieren

' Spalte F

If Not Intersect(Target, Me.Range("F3")) Is Nothing And Me.Range("F3").Value = "" Then
Me.Range("F3").Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-4,'Allgemeine Daten'!$C$3:$C$68,'Kalkulation(intern)'!$I$3:$I$68,""Fehlt"")"
End If

If Not Intersect(Target, Me.Range("F6")) Is Nothing And Me.Range("F6").Value = "" Then
Me.Range("F6").Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-4,'Allgemeine Daten'!$C$3:$C$68,'Kalkulation(intern)'!$I$3:$I$68,""Fehlt"")"
End If

' ... das geht jetzt so im 3-er Schritt weiter bis zur Zeile 240

If Not Intersect(Target, Me.Range("F237")) Is Nothing And Me.Range("F237").Value = "" Then
Me.Range("F237").Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-4,'Allgemeine Daten'!$C$3:$C$68,'Kalkulation(intern)'!$I$3:$I$68,""Fehlt"")"
End If

If Not Intersect(Target, Me.Range("F240")) Is Nothing And Me.Range("F240").Value = "" Then
Me.Range("F240").Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-4,'Allgemeine Daten'!$C$3:$C$68,'Kalkulation(intern)'!$I$3:$I$68,""Fehlt"")"
End If

' Spalte G

If Not Intersect(Target, Me.Range("G4")) Is Nothing And Me.Range("G4").Value = "" Then
Me.Range("G4").Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-4,'Allgemeine Daten'!$C$3:$C$68,'Allgemeine Daten'!$D$3:$D$68,""Fehlt2"")"
End If

If Not Intersect(Target, Me.Range("G7")) Is Nothing And Me.Range("G7").Value = "" Then
Me.Range("G7").Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-4,'Allgemeine Daten'!$C$3:$C$68,'Allgemeine Daten'!$D$3:$D$68,""Fehlt2"")"
End If

' ... das geht jetzt so im 3-er Schritt weiter bis zur Zeile 241

If Not Intersect(Target, Me.Range("G238")) Is Nothing And Me.Range("G238").Value = "" Then
Me.Range("G238").Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-4,'Allgemeine Daten'!$C$3:$C$68,'Allgemeine Daten'!$D$3:$D$68,""Fehlt2"")"
End If

If Not Intersect(Target, Me.Range("G241")) Is Nothing And Me.Range("G241").Value = "" Then
Me.Range("G241").Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-4,'Allgemeine Daten'!$C$3:$C$68,'Allgemeine Daten'!$D$3:$D$68,""Fehlt2"")"
End If

Application.EnableEvents = True ' Ereignisse wieder aktivieren
End Sub



Für die Spalte J und K ist die Formel etwas anders, da ist es dann ein -3 anstelle -4
Für die Spalte N und O ist die Formel dann -2
Für die Spalte R und S ist die Formel dann -1
Für die Spalte V und W dann -0 oder bzw. die Rechenoperation wird weg gelassen.

Die Zeilennummern sind immer die gleichen.

Wie kann ich den Code vereinfachen? Ich habe keine Ahnung.
Falls jemand die Excel benötigt, dann bitte eine PN mit E-Mail-Anschrift, dann sende ich diese ausserhalb des Forums zu. Ich möchte aus dieser doch schon sehr gewachsenen Excel keine "Beispieldatei" bauen müssen.

Vielen Dank schon mal.
LG
Clamsy

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Visual Basic Fehler beim Kompilieren: Prozedur ist zu groß
11.09.2023 13:42:06
peter
Hallo
Für Spalte F



For i =3 to 240 step 3
If target.address="$F$ & i then
if target.value="" then
target.Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-4,'Allgemeine Daten'!$C$3:$C$68,'Kalkulation(intern)'!$I$3:$I$68,""Fehlt"")"
exit for
end If
end if
end if



Peter
AW: Visual Basic Fehler beim Kompilieren: Prozedur ist zu groß
11.09.2023 13:45:17
daniel
HI
du kannst das im Prinzip so vereinfachen.
die Auswahl der leeren Zellen erfolgt über das .Specialcells, so dass hierfür keine eigene Abfrage erforderlich.
Die Formeln bitte selber passend einfügen und den Code an dieser Stelle nach Schema erweitern.
dim rngZeilen as range

dim rngSpalten as range
dim z as long
dim Bereich as range
dim Zelle as Bereich
dim Formel as string

set rngZeilen = Rows(3)
for i = 6 to 240 step 3
set rngZeile = Union(rngZeilen, rows(z)
next

set rngSpalten = Range("F:G,J:K,N:O,R:S,V:W")

on error resume next
set bereich = Intersect(Target, rngZeile, rngSpalten).SpecialCells(xcelltypeblanks)
on error goto 0
if not bereich is nothing then
for each Zelle in Bereich
select Case Zelle.column
Case 6,7: Formel = "=Formel für Spalte F,G"
Case 10, 11: Formel = "=Formel für Spalte J, K"
und so weiter für die weiteren Spalten
case else: Formel = ""
end select
Zelle = Formel
next
end if


Gruß DAniel
Anzeige
AW: Visual Basic Fehler beim Kompilieren: Prozedur ist zu groß
11.09.2023 16:42:09
Yal
Hallo Clamsy,

sehe ich es richtig, dass Du an unzähligen Stellen genau dieselbe Formel platzierst, die dementsprechend genau dasselbe Ergebnis liefern?
Wäre es nicht sinnvoller, diese Formel in einer einzige Zelle zu legen und alle die von der Makro angesprochene Zellen auf dieser zu verlinken?
Die Geschwindigkeit der Applikation würde damit einen Schub bekommen...

Ausserdem denke ich, dass deine Daten unglücklich aufgestellt sind. Eine neue Strukturierung wurde sicher zu einer wesentlich leichteren und schnelleren Applikation führen.

Vielleicht kannst eine "verdummy-sierte" Version deiner Datei erzeugen und hier hochladen. Dann könnte man ein Auge drauf werfen.

VG
Yal
Anzeige
AW: Visual Basic Fehler beim Kompilieren: Prozedur ist zu groß
11.09.2023 14:11:58
GerdL
Hallo Clamsy,

erstmal eingedampft. Welche Zellen in den weiteren Spalten erhalten die Formel; welche Formel?

Private Sub Worksheet_Change(ByVal Target As Range)


Application.EnableEvents = False ' Ereignisse vorübergehend deaktivieren

Select Case Target.Column

Case 6 ' Spalte F
Select Case Target.Row
Case 3 To 240

If Target.Row Mod 3 = 0 Then
If Target = "" Then
Target.Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-4,'Allgemeine Daten'!$C$3:$C$68,'Kalkulation(intern)'!$I$3:$I$68,""Fehlt"")"
End If
End If
End Select

Case 7 'Spalte G
Select Case Target.Row
Case 4 To 241

If Target.Row Mod 3 = 1 Then
If Target = "" Then
Target.Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-4,'Allgemeine Daten'!$C$3:$C$68,'Allgemeine Daten'!$D$3:$D$68,""Fehlt2"")"
End If
End If
End Select

End Select

Application.EnableEvents = True ' Ereignisse wieder aktivieren

End Sub


Gruß Gerd
Anzeige
AW: Visual Basic Fehler beim Kompilieren: Prozedur ist zu groß
11.09.2023 14:30:03
Clamsy
Vielen lieben Dank.

Ich habe es jetzt hinbekommen, dank eurem Denkanstoß ;-)

Mein VB schau jetzt so aus, und es funktioniert :-D



Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False ' Ereignisse vorübergehend deaktivieren

' Countervariable definieren
Dim i As Integer

' Spalte F, J, N, R, V
For i = 3 To 240 Step 3
If Not Intersect(Target, Me.Range("F" & i)) Is Nothing And Me.Range("F" & i).Value = "" Then
Me.Range("F" & i).Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-4,'Allgemeine Daten'!$C$3:$C$68,'Kalkulation(intern)'!$I$3:$I$68,""Fehlt1"")"
End If
If Not Intersect(Target, Me.Range("J" & i)) Is Nothing And Me.Range("J" & i).Value = "" Then
Me.Range("J" & i).Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-3,'Allgemeine Daten'!$C$3:$C$68,'Kalkulation(intern)'!$I$3:$I$68,""Fehlt3"")"
End If
If Not Intersect(Target, Me.Range("N" & i)) Is Nothing And Me.Range("N" & i).Value = "" Then
Me.Range("N" & i).Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-2,'Allgemeine Daten'!$C$3:$C$68,'Kalkulation(intern)'!$I$3:$I$68,""Fehlt5"")"
End If
If Not Intersect(Target, Me.Range("R" & i)) Is Nothing And Me.Range("R" & i).Value = "" Then
Me.Range("R" & i).Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-1,'Allgemeine Daten'!$C$3:$C$68,'Kalkulation(intern)'!$I$3:$I$68,""Fehlt7"")"
End If
If Not Intersect(Target, Me.Range("V" & i)) Is Nothing And Me.Range("V" & i).Value = "" Then
Me.Range("V" & i).Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-0,'Allgemeine Daten'!$C$3:$C$68,'Kalkulation(intern)'!$I$3:$I$68,""Fehlt9"")"
End If
Next

' Spalte G, K, O, S, W
For i = 4 To 241 Step 3
If Not Intersect(Target, Me.Range("G" & i)) Is Nothing And Me.Range("G" & i).Value = "" Then
Me.Range("G" & i).Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-4,'Allgemeine Daten'!$C$3:$C$68,'Allgemeine Daten'!$D$3:$D$68,""Fehlt2"")"
End If
If Not Intersect(Target, Me.Range("K" & i)) Is Nothing And Me.Range("K" & i).Value = "" Then
Me.Range("K" & i).Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-3,'Allgemeine Daten'!$C$3:$C$68,'Allgemeine Daten'!$D$3:$D$68,""Fehlt4"")"
End If
If Not Intersect(Target, Me.Range("O" & i)) Is Nothing And Me.Range("O" & i).Value = "" Then
Me.Range("O" & i).Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-2,'Allgemeine Daten'!$C$3:$C$68,'Allgemeine Daten'!$D$3:$D$68,""Fehlt6"")"
End If
If Not Intersect(Target, Me.Range("S" & i)) Is Nothing And Me.Range("S" & i).Value = "" Then
Me.Range("S" & i).Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-1,'Allgemeine Daten'!$C$3:$C$68,'Allgemeine Daten'!$D$3:$D$68,""Fehlt8"")"
End If
If Not Intersect(Target, Me.Range("W" & i)) Is Nothing And Me.Range("W" & i).Value = "" Then
Me.Range("W" & i).Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-0,'Allgemeine Daten'!$C$3:$C$68,'Allgemeine Daten'!$D$3:$D$68,""Fehlt10"")"
End If
Next

Application.EnableEvents = True ' Ereignisse wieder aktivieren
End Sub
Anzeige

307 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige