Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Mehrere Code in einer Zelle

Mehrere Code in einer Zelle
Gregor
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

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

Betreff
Benutzer
Anzeige
AW: Mehrere Code in einer Zelle
11.10.2011 11:45:52
fcs
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

Anzeige
AW: Mehrere Code in einer Zelle
11.10.2011 12:07:12
Rudi
Hallo,

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

Gruß
Rudi
Anzeige
AW: Mehrere Code in einer Zelle
11.10.2011 12:45:28
Gregor
Hoi zäme
Vielen Dank. Ich habe vorab den Code von Rudi eingebaut. Beim Befehl
arr = GetValues(rngW)
schliesst es mir die Datei, ohne jegliche Anfrage. Den Code "Function GetValues(rng As Range)" habe ich ins gleiche Modul kopiert. Rudi, weisst du, was hier falsch laufen könnte?
Gruss Gregor
AW: Mehrere Code in einer Zelle
11.10.2011 14:52:25
Gregor
Hoi zäme
Ich habe jetzt auch noch den Code von Franz eingebaut, der funktioniert nach meinem Wunsch.
Vielen Dank für die Unterstützung.
Gruss Gregor

416 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige