Hallo
Ich suche eine Formel die den Wert in Spalte A ergänzen kann.
In der Ausgangslage sind die Werte pro Farbe und Spalte immer identisch
Die Zahl in B-E wird nie grösser sein als die Anzahl gleicher Buchstaben in Spalte A
Gruss Enzo
[
attachment=46247]
Hallo Enzo,
wenn du im Erklären annähernd so gut wärst, wie im Gestalten, könnte man eventuell verstehen, was du meinst.
Hallo
und noch eine Lösung als VBA
Code:
Sub Obst()
Dim TB As Worksheet, LR As Integer, I As Integer
Dim LC As Integer, S As Integer, Z1 As Integer, Sp1 As Integer
Dim Anz As Integer, TText As String, J As Integer, MMax As Integer
Set TB = Sheets("Tabellenblatt1")
Z1 = 2 'Überschrift in Zeile 2
Sp1 = 1 'Spalte A
With TB
LR = .Cells(.Rows.Count, Sp1).End(xlUp).Row 'letzte Zeile der Spalte
LC = .Cells(Z1, .Columns.Count).End(xlToLeft).Column 'letzte Spalte einer Zeile
For I = Z1 + 1 To LR
TText = .Cells(I, Sp1)
MMax = WorksheetFunction.CountIf(.Columns(Sp1), TText) ' wie oft
If .Cells(I, Sp1) = TText Then
For S = Sp1 + 1 To LC
Anz = .Cells(I, S)
For J = 1 To Anz
.Cells(I + J - 1, Sp1) = .Cells(I + J - 1, Sp1) & " " & .Cells(Z1, S)
Next
Next
I = I + MMax - 1
End If
Next
End With
End Sub
LG UweD
@UweD
Ich würde ein Array bevorzügen:
Code:
Sub M_snb()
sn = Cells(1).CurrentRegion
n = 1
For j = 3 To UBound(sn)
For jj = 2 To UBound(sn, 2)
If sn(j, jj) > y Then y = sn(j, jj)
If n <= sn(j, jj) Then sn(j, 1) = sn(j, 1) & " " & sn(2, jj)
Next
n = n + 1
If n > y Then
n = 1
y = 0
End If
Next
Cells(1, 7).Resize(UBound(sn), UBound(sn, 2)) = sn
End Sub