Zahlenwert suchen u. Zeile löschen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Beispiel() Dim Bereich As Range, tempBereich As Range Dim A As Long Set Bereich = Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 7)) For A = Bereich.Rows.Count To 1 Step -1 If Not Trim$(Bereich(A, 4)) Like "[0-9]*" Then Exit For If Bereich(A, 4) Like "?7*" Then If tempBereich Is Nothing Then Set tempBereich = Bereich.Rows(A) Else Set tempBereich = Union(Bereich.Rows(A), tempBereich) End If End If Next A If Not tempBereich Is Nothing Then tempBereich.Delete End If End Sub

Sub Beispiel1() Dim Bereich As Range, tempBereich As Range Dim A As Long Set Bereich = Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 8)) For A = Bereich.Rows.Count To 1 Step -1 If Not Trim$(Bereich(A, 1)) Like "[0-9]*" Then Exit For If Bereich(A, 1) Like "?7*" Then If tempBereich Is Nothing Then Set tempBereich = Bereich.Rows(A) Else Set tempBereich = Union(Bereich.Rows(A), tempBereich) End If End If Next A If Not tempBereich Is Nothing Then tempBereich.Delete xlUp End If End Sub

Sub Beispiel1() Dim Bereich As Range, tempBereich As Range Dim A As Long Set Bereich = Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 8)) For A = Bereich.Rows.Count To 1 Step -1 If Not Trim$(Bereich(A, 1)) Like "[0-9]*" Then Exit For If Trim$(Bereich(A, 1)) Like "?7*" Then If tempBereich Is Nothing Then Set tempBereich = Bereich.Rows(A) Else Set tempBereich = Union(Bereich.Rows(A), tempBereich) End If End If Next A If Not tempBereich Is Nothing Then tempBereich.Delete xlUp End If End Sub

Sub Löschen() With ActiveSheet.UsedRange With .Columns(.Columns.Count).Offset(0, 1) .FormulaR1C1Local = "=Wenn(Teil(ZS1;10;1)=""7"";"""";0)" .Formula = .Value Intersect(Range("A:H"), .SpecialCells(xlCellTypeBlanks).EntireRow).Select End With End With End Sub

Servus Walli,
alternativ hab ich mal das Makro geschrieben. Mir scheint nämlich deine Zahlenfolge ist nicht ohne Leerstellen aufgebaut (evtl. Text?):


Sub t()
Dim i As Long, rSuche As Range, rFinde As Range, strErste As String, ZeilenArray() As Long, x  _
As Long, k As Long, lauf As Long
Set rFinde = Range("A:A")
Set rSuche = rFinde.Find(What:="7", LookAt:=xlPart, LookIn:=xlValues, SearchDirection:=xlNext)
If Not rSuche Is Nothing Then
strErste = rSuche.Address
Do
ReDim Preserve ZeilenArray(x)
ZeilenArray(x) = rSuche.Row
x = x + 1
Set rSuche = rFinde.FindNext(rSuche)
Loop While Not rSuche Is Nothing And rSuche.Address  strErste
Else
Exit Sub
End If
For i = UBound(ZeilenArray()) To LBound(ZeilenArray()) Step -1
For k = 1 To Len(Range("A" & ZeilenArray(i)))
If Mid(Range("A" & ZeilenArray(i)), k, 1)  " " Then
lauf = lauf + 1
End If
If lauf = 7 And Mid(Range("A" & ZeilenArray(i)), k, 1) = "7" Then
Range("A" & ZeilenArray(i) & ":H" & ZeilenArray(i)).ClearContents
lauf = 0
Exit For
Else
If lauf > 7 Then
lauf = 0
Exit For
End If
End If
Next k
Next i
End Sub

Gruß
Chris

Beliebteste Forumthreads (12 Monate)

Zahlenwert suchen u. Zeile löschen

18 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread