flexibles suchen nach 2 Kriterien
08.12.2003 13:33:53
Gerhard Henneicke
am 05.12. habe ich schon einmal mein Problem dargestellt und Nepumuk war so nett und hat mir einen Lösungsvorschlag geschickt,
der bei mir leider nicht funktionierte.
Ich habe jetzt mal eine Mustertabelle gehostet. Vielleicht weiß jemand Rat:
Hier nochmals mein Problem:
Mit folgendem Code kann ich eine Tabelle flexibel nach einer Zeichenkette durchsuchen:
Sub Flexibel_zählen()
Dim Anzahl As Double
Dim z As String
z = InputBox("Zu suchende Zeichenfolge eingeben.")
For Each sh In Sheets
Anzahl = Anzahl + Application.WorksheetFunction.CountIf(sh.Range("a:p"), "=" & z)
Next
MsgBox Anzahl
End Sub
Wie bekomme ich es hin, nur zu zählen, wenn eine zweite freiwählbare Zeichenkette in der Zeile vorhanden ist?
Ich hoffe mein Problem ist verständlich geschildert.
Nepumuks Vorschlag:
folgendes Programm sucht, wenn du bei der zweiten abfrage nichts eingibst nur nach einem Begriff.
Groß- und Kleinschreibung werden berücksichtigt. Kann aber auch wegfallen.
Option Explicit
Sub Flexibel_zählen()
Dim lngAnzahl As Long, strSuchbegriff1 As String, strSuchbegriff2 As String
Dim myRange As Range, myWorksheet As Worksheet
strSuchbegriff1 = InputBox("Zu suchende erste Zeichenfolge eingeben.", "Eingabe")
If strSuchbegriff1 <> "" Then
strSuchbegriff2 = InputBox("Zu suchende zweiten Zeichenfolge eingeben.", "Eingabe")
For Each myWorksheet In ThisWorkbook.Worksheets
Set myRange = myWorksheet.Columns("A:P").Find(What:=strSuchbegriff1, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
If Not myRange Is Nothing Then
If strSuchbegriff2 = "" Then
lngAnzahl = lngAnzahl + 1
Else
Set myRange = myWorksheet.Rows(myRange.Row).Find(What:=strSuchbegriff2, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
If Not myRange Is Nothing Then
lngAnzahl = lngAnzahl + 1
End If
End If
End If
Next
MsgBox lngAnzahl
End If
End Sub
Klappt bei mir irgendwie nicht.
Ergebnis ist immer 0, obwohl definitiv mehrfach Kombinationen in der Tabelle sind.
Ich habe mal eine Beispieltabelle geladen. Es wäre super wenn ich eine Lösung dafür bekommen könnte.
https://www.herber.de/bbs/user/2366.xls
Gerhard