Office: (Office 365) Spalte löschen, aber nur teilweise

Hey,


Ich habe ein Problem mit einem Code, hier komme ich nicht wirklich weiter. Er tut zwar was er soll, aber noch nicht wie ich es gerne hätte, da fehlt mir wohl irgendwie die DelRange expertise. : - )

Er fängt an zu suchen in Spalte „D“ und Reihe „17“. Hier wird nach „XX“ gesucht und jedes mal wenn er es findet soll er die Spalte löschen. Das klappt auch soweit, ich hätte es nur gerne wenn er die Spalte

ab Reihe „17“ löscht mit xlToLeft, da üben drüber infos stehen die ich gerne halten würde.

Aktuell wird noch die ganze Spalte gelöscht und das obendrüber ist weg, würde mich freuen wenn jemand eine idee hätte wie ich das geregelt bekommen könnte. : - )


Wollte es mit Button Click starten, alternative wäre es auch als Option denkbar das sobald XX auftaucht wird gelöscht ohne click.


================================================================


Sub Button1_Click()


Dim ws As Worksheet

Dim i As Long

Dim delRange As Range


Set ws = ThisWorkbook.Sheets("Original Values")


With ws


For i = 4 To 200


If UCase(Trim(.Cells(17, i).Value)) = "XX" Then


If delRange Is Nothing Then

Set delRange = .Columns(i)

Else

Set delRange = Union(delRange, .Columns(i))

End If

End If

Next i

End With


If Not delRange Is Nothing Then delRange.Delete xlToLeft


End Sub


================================================================



Vielen Dank,

 

Hier mal einmal in Sauber.. Aber Problem existiert natürlich immer noch :)

Code:

Sub Button1_Click()

    Dim ws As Worksheet
    Dim i As Long
    Dim delRange As Range

    Set ws = ThisWorkbook.Sheets("Original Values")

    With ws

        For i = 4 To 200

            If UCase(Trim(.Cells(17, i).Value)) = "XX" Then

                If delRange Is Nothing Then
                    Set delRange = .Columns(i)
                Else
                    Set delRange = Union(delRange, .Columns(i))
                End If
            End If
        Next i
    End With

    If Not delRange Is Nothing Then delRange.Delete xlToLeft

End Sub

 

Hi,

ersetze an beiden Stellen .Columns(i) durch .Cells(17, i)

Dadurch wird nur die Trefferzelle in Zeile 17 gelöscht. Soll noch mehr gelöscht werden? Wenn ja: Was genau?

 

Vielen Dank für deine Antwort Boris, kam leider heute erst dazu es auszuprobieren :)

Das ist so schon der richtige weg, aber leider noch nicht ganz richtig.

Jetzt löscht er wie du geschrieben hast die Zeile 17, aber ich hätte gerne Zeile 17+Alles was darunter ist .. also z.b. von Zeile 17 bis 117 .. oder 200.. theoretisch wäre auch xlDown denkbar weil nichts wichtiges mehr kommt, es geht nur oben drüber um die Zeilen die müssen erhalten bleiben.

Vielleicht hast du ja noch einen Trick auf lager :)

DANKE!

 

Hallo,

falls mit "Löschen" gemeint ist, dass die Zellen, die sich rechts der zu löschenden Zelle befinden, um 1 Spalte nach links verschoben werden:

Code:

Sub Button1_Click()

    Dim ws As Worksheet
    Dim i As Long
    Dim delRange As Range, Zelle As Range

    Set ws = ThisWorkbook.Sheets("Original Values")

    With ws

        For i = 4 To 200

            If UCase(Trim(.Cells(17, i).Value)) = "XX" Then

                If delRange Is Nothing Then
                    Set delRange = .Cells(17, i)   '.Columns(i)
                Else
                    Set delRange = Union(delRange, .Cells(17, i))    '.Columns(i))
                End If
            End If
        Next i
    End With

    If Not delRange Is Nothing Then
       'delRange besteht aus Zellen der Zeile 17.
       'Falls delRange aus mehreren nicht zusammenhängenden Zellen besteht, ist .Areas.Count > 1
       'Die .Delete-Methode funktioniert nur mit zusammenhängenden Zellbereichen (.Areas.Count = 1)
       For i = delRange.Areas.Count To 1 Step -1
          'Erweitere jeden .Areas-Zellbereich bis Zeile 200
          delRange.Areas(i).Resize(RowSize:=200 - 16).Delete Shift:=xlToLeft
       Next i
    End If
End Sub

Falls mit "Löschen" gemeint wäre, dass nur die Zellinhalte entfernt werden sollen, müsste das anders programmiert werden.

 

Ihr seit der Wahnsinn, genau so ..

Vielen Dank für die genaue Erklärung :) Werde es mir merken.