Code wird nicht ausgeführt

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Dim RNG As Range Dim St As Integer, En As Integer Dim Anz As Variant, i As Integer Dim Arr, MMax As Integer Set RNG = Range("E7:E8") 'Bereich, wo die Eingabe überwacht wird St = 24 'Start ab Spalte AD En = 144 'Ende bei Spalte ES MMax = 7 'maximaler Eingabewert Arr = Array(0, 120, 60, 40, 30, 24, 20, 17) 'Datensatz Nr beginnen mit 0 If Not Intersect(RNG, Target) Is Nothing Then 'Prüfen auf Ganzzahl und MMax, Target Int(Target) MsgBox "Falsche Eingabe" Exit Sub End Select With Application .ScreenUpdating = False 'verhindert das Bildschirmflackern .DisplayAlerts = False ' Schaltet die Warnmeldung aus End With 'Reset With Worksheets("fertig") .Range(.Cells(Target.Row, St), .Cells(Target.Row, En)).UnMerge Anz = Arr(Target) For i = St To En Step Anz If i + Anz > En Then Anz = En - i + 1 .Cells(Target.Row, i).Resize(1, Anz).Merge Next End With With Application .ScreenUpdating = True .DisplayAlerts = True End With End If End Sub

Hey Piet,
vielen Dank für deine Hilfe :)
Leider konnte das mein Problem nicht Lösen =(
Der Code hat zwar ausgelöst, wenn ich Werte in E7:E8 eingetragen habe, hat dann aber nur für Zeile 8 die Zellen verbunden.
In meiner Spalte T wird ja wiedergegeben, wie viele Spalten auf den jeweiligen Zeile (3-37) verbunden werden sollen.
Deshalb ist es schon wichtig, dass er die Werte pro Zeile aus dieser Spalte lesen kann.
Das Ding ist ja, es funktioniert alles wie es soll, nur löst der Code nicht automatisch aus =(
Hab meine Mappe ein bisschen angepasst: https://www.herber.de/bbs/user/150479.xlsm
So soll der Ablauf sein:
1. Im Tabellenblatt "Planung" in Zelle "AH27" wird das Häkchen gesetzt
2. Durch Klick von Häkchen in Punkt 1, werden die Werte aus der Spalte "V" im Tabellenblatt "Planung" in Spalte "T" im Tabellenblatt "fertig" übergeben.
3. Durch Punkt 2 sollte der Code auslösen, was er aber nicht macht.
Man muss dafür die Werte, die im Tabellenblatt "fertig" in Spalte "T" stehen (hab sie mal gelb markiert) nochmals manuell überschreiben (mit den vor eingetragenen Werten). Dann löst der Code für die jeweilige Zeile aus.
Was aber muss ich machen, dass der Code direkt auslöst, sobald man den Haken von Punkt 2 setzt und ich nicht die Werte nochmal abtippen muss.
Für Lösungsvorschläge jeglicher Art bin ich super Dankbar und wünsche einen sonnigen Nachmittag
Gruß Andreas

Hallo Andreas
nachdem ich jetzt die Aufgabe offenbar verstanden habe machen wir das ganz anders, ohne Target Makro!
Dein Auslöser ist doch das Setzen des Häckchens bei der Zelle AI27 auf Wahr oder Falsch! Dmit startet dieses neue Makro!
Du musst dem Häckchen nur mit der rechten Maustaste das Makro zuweisen, das ist alles! Das Leben kann sooo einfach sein!
Das neue Makro verbindet nicht nur eine Zeile wie Target, sondern alle Zeilen von Zeile 3 - 37 in einem Rutsch!
mfg Piet

'neues Makro mit Start über Häckchen Box


Sub Zellen_verbinden_BeiKlick()
Dim Wert As Variant
Dim St As Integer, En As Integer
Dim Anz As Variant, i As Integer
Dim Arr, MMax As Integer, z As Long
Wert = Worksheets("Planung").Range("AI27")
'       If UCase(Wert) = "FALSCH" Then Exit Sub
St = 24   'Start ab Spalte AD
En = 144  'Ende bei Spalte ES
MMax = 7  'maximaler Eingabewert
Arr = Array(0, 120, 60, 40, 30, 24, 20, 17) 'Datensatz Nr beginnen mit 0
'** Bitte prüfen ob Zelle E7 richtig ist?
Wert = Worksheets("Planung").Range("E7").Value
If Not IsNumeric(Wert) Or Wert > MMax Then MsgBox "Falsche Eingabe": Exit Sub
With Application
'.ScreenUpdating = False 'verhindert das Bildschirmflackern
.DisplayAlerts = False ' Schaltet die Warnmeldung aus
End With
'Reset
With Worksheets("fertig")
.Range("Y3:EM37").UnMerge
'1. Schleife für alle Zeilen von 3-37 ausfüllen
For z = 3 To 37
Anz = Arr(Wert)
'2. Schleife um Zellen in dieser Zeile zu verbinden
For i = St To En Step Anz
If i + Anz > En Then Anz = En - i + 1
.Cells(z, i).Resize(1, Anz).Merge
Next i
Next z
End With
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub

Sub Test '1. Schleife für alle Zeilen von 3-37 ausfüllen For z = 3 To 37 Anz = .Cells(z, 20) 'Anzahl aus Spalte T nehmen '2. Schleife um Zellen in dieser Zeile zu verbinden For i = St To En Step Anz If i + Anz > En Then Anz = En - i + 1 .Cells(z, i).Resize(1, Anz).Merge Next i Next z End Sub

Beliebteste Forumthreads (12 Monate)

21
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

311 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Code wird nicht ausgeführt

21 Beiträge zum Forumthread Beiträge zu diesem Forumthread

311 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

21
Beiträge zum Forumthread

Beiträge zu diesem Forumthread