vba: xte Zelle markieren und weiterverarbeiten

[stober]

Guten Tag zusammen,

ich wende mich wieder einmal an euch, um das folgenden Makro fehlerfrei zum laufen zu bringen.
Komme leider gerade einfach nicht mehr weiter.

Es geht darum, in einer großen Menge Excel-Files, die identisch aufgebaut sind, ein bestimmtes Sheet umzuformatieren.
Dazu sollen zunächst exemplarisch die fettgedruckten Spalten markiert werden:
A B C D E F G H I J K L

Im Anschluss soll bei allen markierten Zellen das letzte Zeichen entfernt werden.
Zuletzt soll die Auswahl um eine Zelle nach unten verschoben werden, um dort alle Spalten zu löschen, die eine markierte Zeile mit dem Wert "-2" besitzen.

Hier ist der Code, den ich bisher zustande gebracht habe:

Code:

Sub test()

Worksheets("ADP-IV").Select
Dim I As Long, Adr As String
Adr = Cells(1).Address(0, 0)

For I = 1 To 40
    If (I + 1) Mod 3 = 0 Or (I + 2) Mod 3 = 0 Then
        Adr = Adr & "," & Cells(I).Address(0, 0)
    End If
Next I

Range(Adr).Select

Dim Cell As Range
For Each Cell In Selection
    Cell = Left(Cell, Len(Cell) - 1)
Next

Selection.Offset(1, 0).Select

For Each Cell In Selection
    If Cell.Value = "-2" Then Cell.EntireColumn.Delete
Next

End Sub

Im Wesentlichen funktioniert das Makro, allerdings gibt es 2 Probleme:
Sobald ich in die Markierungsvariable mehr als ca. 100 Spalten einbeziehe, gibt Excel einen Laufzeitfehler 1004 aus.
Das Makro soll allerdings bis Spalte 282 funktionieren.

Wenn die erste markierte Zelle ("A1") gekürzt wird, verschwinden immer 2 Zeichen.
Das kann ich mir leider überhaupt nicht erklären, da der Codeabschnitt bei allen anderen Zellen funktioniert.

Ich lade euch eine Beispieltabelle inkl Makro hoch.


Ich bin dankbar für jede Unterstützung!

Liebe Grüße,
stober

[Fennek]

Hallo,

die Aufgabe bzw Ziel ist schwer verständlich. Der Code

Code:

For I = 1 To 40 'muss bis Zelle 282 kommen
   If (I + 1) Mod 3 = 0 Or (I + 2) Mod 3 = 0 Then
       Adr = Adr & "," & Cells(I).Address(0, 0)
   End If
Next I

ist Murks.

Beschreibe bitte noch einmal, welche Spalten ausgewählt werden sollen: jede dritte?

mfg

[BoskoBiati]

Hi,

1. Die Zelle A1 ist in Deinem Range zweimal enthalten. Das lässt sich im Debug-Modus sehr leicht selbst feststellen!!!!
2. Das Löschen des Zeichens wird wegen 1. eben zweimal angesprochen!


So geht es auch:

Code:

Sub test2()


Dim I As Long, Adr As String

With Worksheets("ADP-IV")

    For I = 282 To 1 Step -1 'muss bis Zelle 282 kommen
        .Cells(1, I) = Left(.Cells(1, I), 7)
        If I Mod 3 <> 0 Then
            If .Cells(2, I) = -2 Then .Cells(2, I).EntireColumn.Delete
        End If
        
    Next
End With
End Sub

[stober]

Hi,

1. Die Zelle A1 ist in Deinem Range zweimal enthalten. Das lässt sich im Debug-Modus sehr leicht selbst feststellen!!!!
2. Das Löschen des Zeichens wird wegen 1. eben zweimal angesprochen!


So geht es auch:

Code:

Sub test2()


Dim I As Long, Adr As String

With Worksheets("ADP-IV")

    For I = 282 To 1 Step -1 'muss bis Zelle 282 kommen
        .Cells(1, I) = Left(.Cells(1, I), 7)
        If I Mod 3 <> 0 Then
            If .Cells(2, I) = -2 Then .Cells(2, I).EntireColumn.Delete
        End If
        
    Next
End With
End Sub

Das ist ziemlich genial. Dagegen ist mein Code wirklich Murks.
Vielen Dank Opa Edgar!

Eine Kleinigkeit noch:
Ab Spalte "AB" mit dem Inhalt "ADPIVA10a" sollen die ersten 8 Zeichen erhalten bleiben (statt 7).
Habe versucht eine Len()-Funktion einzubauen, aber hat leider noch nicht funktioniert.
Könntet ihr mir dabei helfen?

Liebe Grüße
stober

[BoskoBiati]

Hi,

so:

Code:

With Worksheets("ADP-IV")
LenCell=8
    For I = 282 To 1 Step -1 'muss bis Zelle 282 kommen
         if I<28 then LenCell=7    
        .Cells(1, I) = Left(.Cells(1, I), lenCell)
        If I Mod 3 <> 0 Then
            If .Cells(2, I) = -2 Then .Cells(2, I).EntireColumn.Delete
        End If
        
    Next
End With
End Sub

[stober]

Hervorragend!
Ich danke dir herzlich.