AW: Da habe ich mich verrannt/vertan
21.11.2008 09:41:17
fcs
Hallo Wolfgang,
ich hab die Prozedur mal etwas angepasst.
Wenn innerhalb einer Zeile in der Tabelle alle gewählten Kriterien erfüllt werden, dann wird diese Zeile als ein Treffer gezählt.
Für die Treffer werden das Tabellenblatt und die Zeile des Treffers in einem Array gespeichert, so dass du die Informationen ggf. auch weiter verarbeiten kannst.
Gruß
Franz
Private Sub CommandButton1_Click()
Dim intCount As Integer, intI As Integer, i As Integer
Dim arrCheck(1 To 17) As Boolean 'Array für Checkbox status
Dim arrSuch(1 To 17) As String 'Array für Comboboxinhalt
Dim arrSpalte(1 To 17) As Long 'Array für zu durchsuchende Spaltennummer
Dim arrTrefferZeile() As Long 'Array für Treffer-Zeilen
Dim arrTrefferBlatt() As String 'Array für Treffer-Tabellenblatt
Dim bolTreffer As Boolean
Dim lngZeile As Long
Dim wks As Worksheet
Dim strMsg As String
Dim wb As Workbook
Set wb = ActiveWorkbook ' oder ThisWorkbook
'Einlesen der Suchbegriffe, Checkboxstatus und zugeordneter Spalten-Nummer
With Me
i = 1: arrCheck(i) = .CheckBox1.Value: arrSuch(i) = .ComboBox1.Value: arrSpalte(i) = 1
i = 2: arrCheck(i) = .CheckBox2.Value: arrSuch(i) = .ComboBox2.Value: arrSpalte(i) = 2
i = 3: arrCheck(i) = .CheckBox3.Value: arrSuch(i) = .ComboBox3.Value: arrSpalte(i) = 3
i = 4: arrCheck(i) = .CheckBox4.Value: arrSuch(i) = .ComboBox4.Value: arrSpalte(i) = 4
i = 5: arrCheck(i) = .CheckBox5.Value: arrSuch(i) = .ComboBox5.Value: arrSpalte(i) = 5
i = 6: arrCheck(i) = .CheckBox6.Value: arrSuch(i) = .ComboBox6.Value: arrSpalte(i) = 6
i = 7: arrCheck(i) = .CheckBox7.Value: arrSuch(i) = .ComboBox7.Value: arrSpalte(i) = 7
i = 8: arrCheck(i) = .CheckBox8.Value: arrSuch(i) = .ComboBox8.Value: arrSpalte(i) = 8
i = 9: arrCheck(i) = .CheckBox9.Value: arrSuch(i) = .ComboBox9.Value: arrSpalte(i) = 9
i = 10: arrCheck(i) = .CheckBox10.Value: arrSuch(i) = .ComboBox10.Value: arrSpalte(i) = 10
i = 11: arrCheck(i) = .CheckBox11.Value: arrSuch(i) = .ComboBox11.Value: arrSpalte(i) = 11
i = 12: arrCheck(i) = .CheckBox12.Value: arrSuch(i) = .ComboBox12.Value: arrSpalte(i) = 12
i = 13: arrCheck(i) = .CheckBox13.Value: arrSuch(i) = .ComboBox13.Value: arrSpalte(i) = 13
i = 14: arrCheck(i) = .CheckBox14.Value: arrSuch(i) = .ComboBox14.Value: arrSpalte(i) = 14
i = 15: arrCheck(i) = .CheckBox15.Value: arrSuch(i) = .ComboBox15.Value: arrSpalte(i) = 15
i = 16: arrCheck(i) = .CheckBox16.Value: arrSuch(i) = .ComboBox16.Value: arrSpalte(i) = 16
i = 17: arrCheck(i) = .CheckBox17.Value: arrSuch(i) = .ComboBox17.Value: arrSpalte(i) = 17
End With
'Tabellenblätter durchsuchen
For Each wks In wb.Worksheets
Select Case wks.Name
Case "Ziel", "Start", "Anleitung"
'Diese Blätter nicht in Zählung einbeziehen
Case Else
'wks.Activate
With wks
'Zeilenweise prüfen, ob gewählte Kriterien mit Zellinhalten übereinstimmen
For lngZeile = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Row
bolTreffer = True
For intI = 1 To 17
If arrCheck(intI) = True Then
If arrSuch(intI) "" Then
If .Cells(lngZeile, arrSpalte(intI)).Value arrSuch(intI) Then
bolTreffer = False
End If
End If
End If
Next
If bolTreffer = True Then
'Tabellenblatt und Zeile des Treffers in Arrays merken
intCount = intCount + 1
ReDim Preserve arrTrefferBlatt(1 To intCount)
ReDim Preserve arrTrefferZeile(1 To intCount)
arrTrefferBlatt(intCount) = wks.Name
arrTrefferZeile(intCount) = lngZeile
End If
Next
End With
End Select
Next
'meldung vorbereiten
strMsg = "Suckkriterien: " & vbLf
For intI = 1 To 17
If arrCheck(intI) = True Then
If arrSuch(intI) "" Then
strMsg = strMsg & vbLf & "Spalte " & arrSpalte(intI) & ": " & arrSuch(intI)
Else
strMsg = strMsg & vbLf & "Spalte " & arrSpalte(intI) & ": keine Comboboxauswahl"
End If
Else
'strMsg = strMsg & vbLf & "Nr " & intI & ": nicht gecheckt"
End If
Next
strMsg = strMsg & vbLf & vbLf & "Gesamtzahl Treffer: " & intCount
strMsg = strMsg & vbLf & vbLf & "Treffer in den einzelen Tabellen:"
'Treffer in Tabellenblättern ermitteln
For Each wks In wb.Worksheets
Select Case wks.Name
Case "Ziel", "Start", "Anleitung"
'Diese Blätter nicht in Zählung einbeziehen
Case Else
i = 0
For lngZeile = 1 To intCount
If arrTrefferBlatt(lngZeile) = wks.Name Then i = i + 1
Next
strMsg = strMsg & vbLf & wks.Name & " : " & i
End Select
Next
MsgBox strMsg
End Sub