Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1920to1924
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Werte auflisten

Werte auflisten
08.03.2023 06:50:15
Thomas
Guten Morgen Excelfreunde,
GerdL und Daniel haben mir bei dem untenstehenden Makro richtig gut geholfen.
Damit werden alle Zeilen ausgeblendet nicht nicht den Bedingungen entsprechen.
In diesem Beispiel wird die Spalte 10 durchsucht.
https://www.herber.de/forum/archiv/1920to1924/1922874_Spalten_ausblenden_zu_langsam.html

Nun würde ich das Makro gern ein wenig erweitern.
Ist es Möglich die gefundenen Werte in der Tabelle 1 in Spalte b untereinander aufzulisten?
Oder besser gesagt > Alle Werte der Spalte 10, ab Zeile 45, welche die Werte Array("EW", "FS", "!?") enthalten sollen in der Tabelle1 in Spalte B zusätzlich aufgelistet werden.
Ist dies Möglich?
habt schon mal rechtvielen dank für euer Interesse.

mfg thomas
Dim lngZeile As Long
Dim lngLetzte As Long
Dim arrSuch As Variant
Dim i As Long,
Dim bAus As Boolean
Dim arrI

'Inhalte, nach denen gefiltert werden soll
arrSuch = Array("EW", "FS", "!?")

'letzte Zeile in Spalte E ermitteln
lngLetzte = Cells(Rows.Count, 10).End(xlUp).Row

'nun alle Zeilen in Spalte E ab Zeile 2 durchlaufen (Zeile 1 enthält Überschrift - ggf. anpassen)
arrI = Cells(1, 10).Resize(lngLetzte, 1).value
For lngZeile = 45 To lngLetzte
'Marker für Ausblenden auf wahr setzen
bAus = True
'Array mit Suchbegriffen durchlaufen
For i = 0 To 2
If InStr(1, arrI(lngZeile, 1), arrSuch(i)) Then
bAus = False
Exit For 'Schleife für Array beenden
End If
Next i

if bAus Then
if rngAus is nothing then
set rngAus = rows(lngZeile)
else
set rngAus = union(rngAus, Rows(lngZeile))
end if
end if

Next lngZeile
if not rngAus is nothing then rngAus.EntireRow.Hidden = True

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

Betreff
Datum
Anwender
Anzeige
AW: Werte auflisten
08.03.2023 10:06:34
Rudi
Hallo,
ungetestet:
Sub ausblenden()
  Dim lngZeile As Long
  Dim lngLetzte As Long
  Dim arrSuch As Variant
  Dim i As Long
  Dim bAus As Boolean
  Dim arrI
  Dim strAUS As String, vntAUS
  
  'Inhalte, nach denen gefiltert werden soll
  arrSuch = Array("EW", "FS", "!?")
  
  'letzte Zeile in Spalte E ermitteln
  lngLetzte = Cells(Rows.Count, 10).End(xlUp).Row
  
  'nun alle Zeilen in Spalte E ab Zeile 2 durchlaufen (Zeile 1 enthält Überschrift - ggf. anpassen)
  arrI = Cells(1, 10).Resize(lngLetzte, 1).Value
  For lngZeile = 45 To lngLetzte
    'Marker für Ausblenden auf wahr setzen
    bAus = True
    'Array mit Suchbegriffen durchlaufen
    For i = 0 To 2
      If InStr(1, arrI(lngZeile, 1), arrSuch(i)) Then
        bAus = False
        Exit For 'Schleife für Array beenden
      End If
    Next i
    
    If bAus Then
      strAUS = strAUS & "|" & Cells(lngZeile, 10)
      If rngAus Is Nothing Then
        Set rngAus = Rows(lngZeile)
      Else
        Set rngAus = Union(rngAus, Rows(lngZeile))
      End If
    End If
  Next lngZeile
  
  If Not rngAus Is Nothing Then
    rngAus.EntireRow.Hidden = True
    vntAUS = Split(Mid(strAUS, 2), "|")
    Tabelle1.Cells(1, 2).Resize(UBound(vntAUS) + 1) = Application.Transpose(vntAUS)
  End If
  
End Sub
Gruß
Rudi
Anzeige
AW: Werte auflisten
08.03.2023 12:33:33
Thomas
Hallo Rudi,
hab besten dank das du dir dies mal angeschaut und bearbeitet hast.
Mit deinen derzeitigen Vorschlag werden alle Werte aufgelistet die diese Kriterien ( Array("EW", "FS", "!?") nicht entsprechen. Die Werte der Zeilen die ausgeblendet werden.
Bekommst du dies auch hin, das nur die Werte aufgelistet werden die eines dieser Kriterien entsprechen? ( die Werte aus den Zellen / Zeilen die nicht ausgeblendet werden.
hab schon mal rechtvielen dank für die Unterstützung
mfg thomas
AW: Werte auflisten
08.03.2023 12:49:29
Rudi
    If bAus Then
      If rngAus Is Nothing Then
        Set rngAus = Rows(lngZeile)
      Else
        Set rngAus = Union(rngAus, Rows(lngZeile))
      End If
    else
      strAUS = strAUS & "|" & Cells(lngZeile, 10)
    End If

Anzeige
Jetzt passt es besten dank an Rudi Maintaire
08.03.2023 13:36:59
Thomas
Hallo Rudi,
jetzt passt es perfekt.
Wie schafft ihr das bloß immer. In diesem Fall auch noch ohne Datei.
Hab riesen Dank, für deine schnelle Hilfe.
mfg thomas

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige