|
Hallo Forum,
ich habe ein Problem mit vba.
Ich habe eine Tabelle mit Produkten (x-Achse) und Inhaltsstoffen (y-Achse). Wenn ein Produkt einen Stoff enthält ist in der Zeile ein x.
Jetzt möchte ich mehrere Inhaltsstoffe zu Clustern zusammenfassen und diese in der Tabelle farblich markieren, eben für alle Produkte, die das Cluster ( also alle Inhalsstoffe und nur die) enthalten.
Für jedes Cluster habe ich ein neues Tabllenblatt. Mein Problem bisher ist, dass ich für jedes Cluster einen neuen Code brauche, da ein Cluster sich aus einer variablen Anzahl an Inhaltsstoffen zusammensetzt. Für 2 CLuster sind hier meine Codes.
Sub Cluster1()
Dim Block As Variant
Dim Zeile(1 To 7) As Long
Dim stp(1 To 7) As Integer
Block = "Cluster 1"
Z = Worksheets(Block).Cells(1, 4).Interior.Color
For J = 1 To 5 ' muss angepasst werden für jedes Cluster
If Worksheets(Block).Cells(J, 2) <> 0 Then
stp(J) = Worksheets(Block).Cells(J, 2).Value
Zeile(J) = Columns("A:A").Find(What:=stp(J), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Row
End If
Next
For i = 2 To 10 'Anzahl der Spalten, die durchsucht werden
If Cells(Zeile(3), i).Value = "x" And Cells(Zeile(4), i).Value = "x" And Cells(Zeile(5), i).Value = "x" Then 'muss angepasst werden für jeden Cluster
Range(Cells(Zeile(1), i), Cells(Zeile(2) - 1, i)).Select
Cells(Zeile(2) - 1, i).Activate
With Selection.Interior
.Color = Z
End With
End If
Next i
End Sub
Sub Cluster2()
Dim Block As Variant
Dim Zeile(1 To 7) As Long
Dim stp(1 To 7) As Integer
Block = "Cluster 2"
Z = Worksheets(Block).Cells(1, 4).Interior.Color
For J = 1 To 4
If Worksheets(Block).Cells(J, 2) <> 0 Then
stp(J) = Worksheets(Block).Cells(J, 2).Value
Zeile(J) = Columns("A:A").Find(What:=stp(J), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Row
End If
Next
For i = 2 To 10 'Anzahl der Spalten, die durchsucht werden
If Cells(Zeile(3), i).Value = "x" And Cells(Zeile(4), i).Value = "x" Then
Range(Cells(Zeile(1), i), Cells(Zeile(2) - 1, i)).Select
Cells(Zeile(2) - 1, i).Activate
With Selection.Interior
.Color = Z
End With
End If
Next i
End Sub
Das Makro guckt in Tabelle1 ob die im CLuster aufgelisteten Inhaltsstoffe in einem Produkt enthalten sind, falls alle drin sind wird der Bereich (im Tabellenblatt Cluster def.) gefärbt.
Kann man da eine variable Anzahl an if and Verknüpfungen einpflegen, so dass ich nur einen COde brauche?
Danke
|