Wert nach Regel ergänzen

[Enzo3]

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

  Unbenannte Tabelle.xlsx (Größe: 41,46 KB / Downloads: 7)

[Klaus-Dieter]

Hallo Enzo,

wenn du im Erklären annähernd so gut wärst, wie im Gestalten, könnte man eventuell verstehen, was du meinst.

[Gastlich]

Hallo,

als Matrixformel.

PHP-Code:

=A3&" "&TEXTVERKETTEN(" ";1;WENN(ZÄHLENWENN(A$3:A3;A3)<=B3:E3;$B$2:$E$2;"")) 


[snb]

In F18:

PHP-Code:

=IF(COUNTIF(F$18:F18;"*" & $B$18 & "*")<$B$19;$B$18;"")&IF(COUNTIF($F$18:$F18;"*" & $C$18 & "*")<$C$19;" " &$C$18;"")&IF(COUNTIF($F$18:$F18;"*" & $D18& "*")<$D$19;" " &$D$18;"")&IF(COUNTIF($F$18:$F18;"*" & $E$18 & "*")<$E$19;" " &$E$18;"") 


[UweD]

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

[snb]

@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