Problem mit einem Makro
Tom
Es soll immer aus einer Zelle einen Wert auslesen und anhand diesem entweder einen bestimmten Spaltenblock kopieren oder eben löschen bis der entsprechende Wert mit der Anzahl der Blöcke übereinstimmt.
Das Ganze funktioniert auch soweit. Nur hab ich das Problem dass in diesem Spaltenblock auch Buttons vorhanden sind die ein anderes Makro aufrufen. Diese Buttons sollen beim löschen der Spalten dann auch gelöscht werden. Doch da ist irgentwie der Haken. Manchmal funktioniert das eben und manchmal (ich weiß leider nicht wann oder warum) kommt eben der 'Laufzeitfehler 1004' - Anwendungs- oder Objektorientierter Fehler
Also hier mal mein Makro mit Dokumentation
Sub Stationen_anpassen()
Dim IntRow As Integer
Dim IntCol As Integer
Dim i As Integer
Dim x As Integer
Dim y As Integer
Dim F As Integer
Dim IntButtonPos As Integer
Dim ButtonShape As Shape
Dim Sheet As Worksheet
Set Sheet = ActiveWorkbook.Worksheets("Daten für Abschätzung")
IntRow = 1
Application.Calculation = xlManual
Application.ScreenUpdating = False
'suchen von "Anzahl der Stationen"
Do Until Cells(IntRow, 1).Value = "Anzahl der Stationen"
IntRow = IntRow + 1
Loop
IntButtonPos = 1
Do Until Cells(IntButtonPos, 1).Value = "Details" 'Zeile der Details _
suchen
IntButtonPos = IntButtonPos + 1
Loop
Do Until Cells(IntButtonPos, 1).Interior.ColorIndex = xlNone 'Zeile des Buttons _
suchen
IntButtonPos = IntButtonPos + 1
Loop
If Cells(IntRow, 2).Value "" Then 'Überprüfen ob Wert in _
Anzahl der Stationen steht
x = Cells(IntRow, 2).Value 'Anzahl der Stationen _
an X übergeben
IntCol = 7 'Startspalte der Suche _
festlegen
Do Until Cells(IntRow, IntCol).Value = "Stations-Bezeichnung" 'Zeile der _
Stationsbezeichnungen suchen
IntRow = IntRow + 1
Loop
y = 1 'Anzahl der vorhandenen _
Stationen auf 1 setzen
Do While Cells(IntRow, IntCol + 5).Value = "Stations-Bezeichnung" 'Überprüfen ob eine _
weitere Station vorhanden ist
IntCol = IntCol + 5 'Spalte anpassen
y = y + 1 'Anzahl der vorhanden _
Stationen um 1 erhöhen
Loop
If x > y Then 'Überprüfen ob weniger _
Stationen vorhanden sind als es benötigt
For i = 1 To x - y 'Falls ja, so viele _
Spalten anfügen wir fehlen
Range(Columns(IntCol), Columns(IntCol + 4)).Copy Columns(IntCol + 5)
IntCol = IntCol + 5
Next i
ElseIf x ButtonShape.TopLeftCell.Row = IntCol Then ButtonShape.Delete
Leider weiß ich nicht mehr weiter. Ich sitz nun schon mehrere Arbeitstage an diesem Problem und find nicht die Ursache des Fehlers noch kann ich ihn beheben.
Ich hoffe hier kann jemand helfen