|
Realisiert wurde das durch eine VBA-Lösung.
Es wurde eine Hilfstabelle für die gesamten Daten mit dem Namen "Daten" angelegt. In einem anderen Tabellenblatt wurden vier Kombinationsfelder (ComboBoxen) eingefügt, die die entsprechenden Daten anzeigen und aus denen man diverse Begriffe auswählen sollte.
Der Code ist in das
VBA-Projekt der Tabelle
einzufügen, in dem die ComboBoxen
positioniert sind, einzufügen.
Public Auswahl1 As String, Auswahl2 As String, Auswahl3 As String
Private Sub ComboBox1_GotFocus()
'***************************************************************************
'Bei Eingabefokus der ComboBox1
'***************************************************************************
Dim Wiederholungen As Integer
'Alle Einträge in der Combobox löschen
ComboBox1.Clear
'sichtbaren Eintrag in der Combobox löschen
ComboBox1.Text = ""
'For/Next Schleife um Combobox mit den Einträgen aus Blatt "Daten" Spalte A
'ohne Duplicat zu füllen.
For Wiederholungen = 2 To Worksheets("Daten").Range("A65536").End(xlUp).Row
If WorksheetFunction.CountIf(Worksheets("Daten"). _
Range("A2:A" & Wiederholungen), Worksheets("Daten"). _
Cells(Wiederholungen, 1)) = 1 Then _
ComboBox1.AddItem Worksheets("Daten").Cells(Wiederholungen, 1)
Next Wiederholungen
End Sub
Private Sub ComboBox1_Change()
'***************************************************************************
'Bei Änderung der ComboBox1
'***************************************************************************
Dim Wiederholungen As Integer
'Alle Einträge in der Combobox löschen
ComboBox2.Clear
'Sichtbaren Eintrag in der Combobox löschen
ComboBox2.Text = ""
'Letzte beschriebene Zeile in Blatt Daten ermitteln
Letzte_Zeile = Sheets("Daten").Range("A65536").End(xlUp).Row
'Ausgewählter Eintrag aus der Combobox in Variable "Auswahl1"
'schreiben
Auswahl1 = ComboBox1.Text
'For/Next Schleife um Combobox mit den Einträgen aus Blatt "Daten"
'Spalte B ohne Duplikat zu füllen.
For Wiederholungen = 2 To Letzte_Zeile
'Wenn der ausgewählte Begriff = dem Eintrag in Spalte A in der Zeile,
'die durch die For/Next Schleife angesprochene Zeile dann...
If Sheets("Daten").Cells(Wiederholungen, 1) = Auswahl1 Then
'...Eintag aus Blatt "Daten" Spalte B der durch die For/Next Schleife
'angesprochenen Zeile in Spalte IV kopieren
Sheets("Daten").Cells(Wiederholungen, 2).Copy Cells(Wiederholungen, 256)
'Duplikate löschen
If WorksheetFunction.CountIf(Range("IV2:IV" & Wiederholungen), _
Cells(Wiederholungen, 256)) = 1 Then _
'Werte in ComboBox eintragen
With ComboBox2
.AddItem Sheets("Daten").Cells(Wiederholungen, 2)
End With
End If
End If
'Nächster Schleifendurchlauf
Next Wiederholungen
'Daten in Spalte IV löschen
Range("IV2:IV" & Letzte_Zeile).ClearContents
End Sub
Private Sub ComboBox2_Change()
'***************************************************************************
'Bei Änderung der ComboBox2
'***************************************************************************
Dim Wiederholungen As Integer
'Alle Einträge in der Combobox löschen
ComboBox3.Clear
'Sichtbaren Eintrag in der Combobox löschen
ComboBox3.Text = ""
'Letzte beschriebene Zeile in Blatt Daten ermitteln
Letzte_Zeile = Sheets("Daten").Range("A65536").End(xlUp).Row
'Ausgewählter Eintrag aus der Combobox in Variable "Auswahl1"
'schreiben
Auswahl2 = ComboBox2.Text
'For/Next Schleife um Combobox mit den Einträgen aus Blatt "Daten"
'Spalte B ohne Duplikat zu füllen.
For Wiederholungen = 2 To Letzte_Zeile
'Wenn der ausgewählte Begriff = dem Eintrag in Spalte B in der Zeile,
'die durch die For/Next Schleife angesprochene Zeile und
'der ausgewählte Begriff aus der Combobox1 = dem Eintrag in Spalte A
'in der Zeile, die durch die For/Next Schleife angesprochene Zeile dann...
If Sheets("Daten").Cells(Wiederholungen, 2) = Auswahl2 And _
Sheets("Daten").Cells(Wiederholungen, 1) = Auswahl1 Then
'...Eintag aus Blatt "Daten" Spalte B der durch die For/Next Schleife
'angesprochenen Zeile in Spalte IV kopieren
Sheets("Daten").Cells(Wiederholungen, 3).Copy Cells(Wiederholungen, 256)
'Duplikate löschen
If WorksheetFunction.CountIf(Range("IV2:IV" & Wiederholungen), _
Cells(Wiederholungen, 256)) = 1 Then _
'Werte in ComboBox eintragen
With ComboBox3
.AddItem Sheets("Daten").Cells(Wiederholungen, 3)
End With
End If
End If
'Nächster Schleifendurchlauf
Next Wiederholungen
'Daten in Spalte IV löschen
Range("IV2:IV" & Letzte_Zeile).ClearContents
End Sub
Private Sub ComboBox3_Change()
'***************************************************************************
'Bei Änderung der ComboBox3
'***************************************************************************
Dim Wiederholungen As Integer
'Alle Einträge in der Combobox löschen
ComboBox4.Clear
'Sichtbaren Eintrag in der Combobox löschen
ComboBox4.Text = ""
'Letzte beschriebene Zeile in Blatt Daten ermitteln
Letzte_Zeile = Sheets("Daten").Range("A65536").End(xlUp).Row
'Ausgewählter Eintrag aus der Combobox in Variable "Auswahl1"
'schreiben
Auswahl3 = ComboBox3.Text
'For/Next Schleife um Combobox mit den Einträgen aus Blatt "Daten"
'Spalte B ohne Duplikat zu füllen.
For Wiederholungen = 2 To Letzte_Zeile
'Wenn der ausgewählte Begriff = dem Eintrag in Spalte C in der Zeile,
'die durch die For/Next Schleife angesprochene Zeile und
'der ausgewählte Begriff aus der Combobox2 = dem Eintrag in Spalte B
'in der Zeile, die durch die For/Next Schleife angesprochene Zeile und
'der ausgewählte Begriff aus der Combobox1 = dem Eintrag in Spalte A
'in der Zeile, die durch die For/Next Schleife angesprochene Zeile
dann...
If Sheets("Daten").Cells(Wiederholungen, 3) = Auswahl3 And _
Sheets("Daten").Cells(Wiederholungen, 2) = Auswahl2 And _
Sheets("Daten").Cells(Wiederholungen, 1) = Auswahl1 Then
'...Eintag aus Blatt "Daten" Spalte B der durch die For/Next Schleife
'angesprochenen Zeile in Spalte IV kopieren
Sheets("Daten").Cells(Wiederholungen, 4).Copy Cells(Wiederholungen, 256)
'Duplikate löschen
If WorksheetFunction.CountIf(Range("IV2:IV" & Wiederholungen), _
Cells(Wiederholungen, 256)) = 1 Then _
'Werte in ComboBox eintragen
With ComboBox4
.AddItem Sheets("Daten").Cells(Wiederholungen, 4)
End With
End If
End If
'Nächster Schleifendurchlauf
Next Wiederholungen
'Daten in Spalte IV löschen
Range("IV2:IV" & Letzte_Zeile).ClearContents
End Sub
|
Dieses Beispiel wurde unter den in der
Tabelle aufgeführten Versionen getestet.
|
|
A |
B |
C |
D |
E |
|
1 |
|
|
|
|
|
2 |
|
Excel - Version |
Getestet |
|
|
3 |
|
|
|
|
4 |
|
Excel 2007 |
12.0 |
a |
|
|
5 |
|
Excel 2003 |
11.0 |
a |
|
|
6 |
|
Excel 2002 |
10.0 |
a |
|
|
7 |
|
Excel 2000 |
9.0 |
a |
|
|
8 |
|
Excel 97 |
8.0 |
|
|
|
9 |
|
|
|
|
|
|
10 |
|
Anzahl der Downloads: |
|
|
|
11 |
|
|
|
|
|
|
12 |
|
Dieses Beispiel wurde bereits
x
aufgerufen. |
|
|
13 |
|
|
|
14 |
|
|
|
|
|
|