Array und Tabellenvergleich
29.09.2007 10:50:39
Vinz
irgendwie hab ich mich mit meinen bescheidenen Kenntnissen total verrannt und blicke jetzt nicht mehr durch.
Ich habe eine Tabelle Einstellungen, eine Spalte mit Hintergrundfarben, nächste Spalte mit dazugehörigen Suchkriterien (das Ganze 4 mal). Über eine Userform mit Checkboxen deren Caption mit den Suchkriterien aus der Tabelle Einstellungen belegt wird, möchte ich die Suchkriterien auswählen. Bei Betätigen des OK-Buttons sollen die ausgewählten Suchkriterien in ein Array geschrieben werden (soweit funktionierts).
Jetzt soll zu den ausgewählten Suchkriterien, die in der 1. Dimension des Arrays stehen, die zugehörigen Hintergrundfarben ins Array eingelesen werden. In meiner Vorstellung habe ich jetzt ein Array in dem die gewünschten Suchkriterien und zugehörigen Farben aus der Tabelle Einstellungen stehen.
Danach soll eine andere Tabelle (Auswertung.xls, Tabelle1) geladen werden, die auf die Suchkriterien des Arrays durchsucht und bei einem Treffer die Zelle mit der entsprechenden Hintergrundfarbe belegt.
Da die auszuwertende Tabelle einige Datensätze mitbringen kann, kam die Idee mit dem Array. Mein herkömmliches Hausgebrauchs-Makro braucht zu lange.
Eigentlich müsse dies doch ganz einfach zu bewerkstelligen sein, aber irgendwie krieg ich die Kurve nicht ...
Und weils mit einer Mappe verständlicher ist:
https://www.herber.de/bbs/user/46433.xls
Wäre super, wenn mir hier jemand weiterhelfen könnte.
Vielen Dank im Voraus
Vinz
Private Sub cmdOK_Click()
Dim KritArray() As Variant
Dim ctrl As Control 'MSForms.Control
Dim iChkbox, iCol, iRow, lCol, lRow As Integer
Dim rngCBCap As Range
' Caption der ausgewählten Checkboxen in Array einlesen
With filterMaske
For Each ctrl In Controls
If TypeName(ctrl) = "CheckBox" Then
If ctrl.Value Then
iChkbox = iChkbox + 1
'Option Base 1
ReDim Preserve KritArray(1 To iChkbox, 1)
KritArray(iChkbox, 0) = ctrl.Caption
' Auf Blatt Einstellungen die Captions (kommen nur einmal vor)
' im Array suchen und zugehörige Hintergrundfarbe ins Array schreiben
With Worksheets("Einstellungen")
lCol = .Cells(1, Columns.Count).End(xlToLeft).Column
For iCol = 1 To lCol
If iCol Mod 2 = 0 Then
lRow = .UsedRange.Rows.Count
For iRow = 2 To lRow
Set rngCBCap = Cells(iRow, iCol)
If rngCBCap.Value = KritArray(iChkbox, 0) Then
KritArray(iChkbox, 1) = rngCBCap.Offset(0, -1).Interior. _
ColorIndex
End If
Next iRow
End If
Next iCol
End With
End If
End If
Next ctrl
End With
' Tabelle zum Auswerten laden
' Tabelleneinträge anhand der Werte im Array durchsuchen und
' wenn gefunden Eintrag mit zugehöriger Hintergrundfarbe markieren
Unload Me
End Sub