Mehrere Code in einer Zelle

Hoi zäme
Folgender Code hat mir Rudi zum löschen von Zeilen zugestellt, wenn in Zellen Code nicht vorhanden:
AnfangInput = 1600
EndeInput = 1800
For z = 10 To intLastRow - 1
Set rngW = Union(Range(Cells(z, 18), Cells(z, 21)), Range(Cells(z, 23), Cells(z, 27)))
If Application.Min(rngW) >= AnfangInput And Application.Max(rngW) Else
If rngHide Is Nothing Then
Set rngHide = Cells(z, 1)
Else
Set rngHide = Union(rngHide, Cells(z, 1))
End If
End If
Next z
If Not rngHide Is Nothing Then rngHide.EntireRow.Hidden = True
Dieser funktioniert bestens. Nun habe ich aber in einigen Zellen mehrere Code, abgetrennt mit je einem Zeilenumbruch. Diese werden mit diesem Code nicht erasst. Ist es möglich, auch diese das heisst einzelne Code in Zellen zu eruieren und bei Zustimmung eben nicht zu löschen?
Vielen Dank und Gruss
Gregor

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Gregor,
dann bleibt nichts anderes übrig, als den Inhalt der Zellen jeweils per Split zu zerlegen und in einer Schleife gegen Anfangs und Endwert zu prüfen.
Sollte dann etwa wie folgt aussehen.
Gruss
Franz


Sub a()
Dim AnfangInput As Double, EndeInput As Double
Dim Z As Long, lngSpalte As Long, intLastRow As Long
Dim intI As Integer
Dim rngW As Range, rngHide As Range
Dim boolMin As Boolean, boolMax As Boolean, boolLeer As Boolean
Dim varInhalt As Variant, dblNumber As Double
ActiveSheet.Rows.Hidden = False                                               'Testzeile
intLastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1 'Testzeile
AnfangInput = 1600
EndeInput = 1800
For Z = 10 To intLastRow - 1
boolLeer = True 'zurücksetzen - alle Zellen leer bzw. enthalten Text
boolMin = True  'zurücksetzen - Min-Wert-Bedingung ist erfüllt
boolMax = True  'zurücksetzen - Max-Wert-Bedingung ist erfüllt
For lngSpalte = 18 To 27
Select Case lngSpalte
Case 18 To 21, 23 To 27
'Zellinhalt an Zeilenschaltung splitten
varInhalt = Split(Cells(Z, lngSpalte).Value, Chr(10))
For intI = LBound(varInhalt) To UBound(varInhalt)
If Trim(varInhalt(intI)) = "" Then
'do nothing - Zelle/Zeile ist leer
ElseIf IsNumeric(Trim(varInhalt(intI))) Then
boolLeer = False
dblNumber = CDbl(Trim(varInhalt(intI)))
If dblNumber  EndeInput Then boolMax = False
End If
Next
End Select
If boolMin = False Or boolMax = False Then Exit For
Next lngSpalte
If boolLeer = True Or boolMin = False Or boolMax = False Then
If rngHide Is Nothing Then
Set rngHide = Cells(Z, 1)
Else
Set rngHide = Union(rngHide, Cells(Z, 1))
End If
End If
Next Z
If Not rngHide Is Nothing Then rngHide.EntireRow.Hidden = True
End Sub

Sub bbbbb() Dim AnfangInput, EndeInput, rngW As Range, z As Long, rngHide As Range, intLastRow As Long, _ arr AnfangInput = 1600 EndeInput = 1800 intLastRow = Cells(Rows.Count, 1).End(xlUp).Row For z = 10 To intLastRow Set rngW = Union(Range(Cells(z, 18), Cells(z, 21)), Range(Cells(z, 23), Cells(z, 27))) arr = GetValues(rngW) If Application.Min(arr) >= AnfangInput And Application.Max(arr)

Function GetValues(rng As Range) Dim arr(), i As Integer, n As Integer, rngC As Range, tmp For Each rngC In rng tmp = Split(rngC, vbLf) For i = 0 To UBound(tmp) If IsNumeric(tmp(i)) Then ReDim Preserve arr(n) arr(n) = tmp(i) n = n + 1 End If Next Next ReDim Preserve arr(n - 1) GetValues = arr End Function

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

366 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Mehrere Code in einer Zelle

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

366 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread