Codeanpassung_Change-zu-Sub
12.04.2022 14:28:00
Henny
Ausgangslage:
Der liebe onur hat mir neulich folgende Lösung gebaut:
https://www.herber.de/bbs/user/152367.xlsm
Mit seiner Lösung wird zum einen, wenn ein ja/nein-Wert in den Spalten B-F geändert wird, automatisch eine "Binärvariable" daraus gebaut, als auch gezählt, wie viele verschiedene "Binärcodes" vorliegen (nummeriert also in Spalte H von 1 hoch, gleicher Wert kriegt gleiche Nummer. Gelbe Zellen).
Wenn man dann auf den Button klickt, erzeugt er neue Blätter, abhängig von der Zahl der verschiedenen Binärcodes.
Situation:
Ich habe versucht, den Code auf eine andere Tabelle anzuwenden.
Diese hat aktuell ca. 70 Zeilen.
Das Problem ist, dass mir Excel da leider abstürzt; er führt aus, er schreibt die Nummern neben die Binärcodes, aber dann wird alles "weiß-milchig" und bleibt so für 30min, ich muss dann also mit Task-Manager Excel zumachen.
Was ich bereits versucht habe:
Ich habe den Code an den fetten Stellen zum einen an die Tabelle angepasst (die entsprechenden Spalten sind R und S, also 18 und 19) sowie Anzahl der Zeilen von initial auf 11000 auf 110 gesetzt, in der Hoffnung, dass das das Problem löst.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim z, s, o, i As Integer, ze, Code As Object
z = Target.Row: s = Target.Column
If s 26 Then Exit Sub
Set Code = CreateObject("Scripting.Dictionary")
With Code
For ze = 3 To 110
o = CStr(Cells(ze, 18))
If o "" Then
If Not .exists(o) Then
i = i + 1
.Add o, i
End If
End If
Next ze
End With
For ze = 3 To 110
If Cells(ze, 18) "" Then Cells(ze, 19) = Code(CStr(Cells(ze, 18)))
Next ze
End Sub
1) Kann jemand so sehen, warum Excel da abstürzt?
2) Ist es möglich, den obigen Code so zu machen, dass er erst auf Button-Druck ausgeführt wird?
Viele Grüße!
Henny