Matrixformel per VBA (Excel 2003)

[Jockel]

Hallo Jörg,

wenn du mit Nachbarforum das Office-Forum meinst, dann war das eine reine Verzweiflungstat, weil das Clever-Forum nicht mehr vorhanden war und ich dieses neue Forum hier noch nicht entdeckt hatte.

Im Office-Forum habe ich auch eine Formellösung bekommen - damit war der Fall dort für mich erledigt.

Als sich dann herausstellte, dass es mit der dort angebotenen Matrixformel per VBA Probleme gibt - habe ich hier nach einer neuen Lösung für VBA gesucht.

Ich glaube nicht, dass ich mich rechtfertigen muss, nur weil ich einmal in einem anderen Forum nachgefragt habe.


Die Formel mit ZählenwennS funktioniert in Excel2003 nicht.

Gruß
Silke

hi Silke, mal ganz davon abgesehen, dass ich gar nicht will, dass du dich rechtfertigst, hatte ich das ja auch dort schon geschrieben dass ZÄHLENWENNS() nicht in XL2003 funzt, aber da kam ja noch eine nach... von Sir Erich Balten

da es ums gleiche thema geht - nur ein schritt weiter, hätte ich auf den anderen thread verwiesen... um anderen arbeit zu ersparen...

und so richt erledigt schien es sich ja nicht zu haben... wie du hier schreibst...

aber nochmal: rechtfertigen sollst du dich nicht...

[Silki]

Hallo Edgar,

mmmh, das sieht gut aus.
Ich versuche mal das in meine Datei einzubauen und melde mich dann wieder (nach Ostern).

Erstmal schonmal ein dickes DANKESCHÖN an alle und Frohe Ostern!

Gruß
Silke

[atilla]

Hallo Silke,

wie ich vermutet habe, funktionierte mein Code nicht richtig.

Dieser müsste jetzt gehen:

Code:

Sub numerieren_Ati_2()
   Dim i As Long, k As Long, j As Long
   Dim lngLetzte As Long
   Dim lngMax As Long
      lngLetzte = Cells(Rows.Count, 2).End(xlUp).Row
      Range("A2:A" & lngLetzte).ClearContents
      Application.ScreenUpdating = False
      For i = 2 To lngLetzte
         If Application.CountIf(Range("B1:B" & i - 1), Cells(i, 2)) = 0 Then
            If Application.CountIf(Range("C1:C" & i - 1), Cells(i, 3)) = 0 Then
               Cells(i, 1) = Cells(i, 3) & "01"
            Else
               For k = i - 1 To 2 Step -1
                  If Cells(k, 3) = Cells(i, 3) Then
                     If lngMax < Right(Cells(k, 1), 2) Then lngMax = Right(Cells(k, 1), 2)
                  End If
               Next k
               Cells(i, 1) = Cells(i, 3) & Format(lngMax + 1, "00")
               lngMax = 0
            End If
         Else
            j = Range("B2:B" & i - 1).Find(Cells(i, 2), lookat:=xlWhole).Row
            Cells(i, 1) = Cells(j, 1)
         End If
      Next i
      Application.ScreenUpdating = True
End Sub

Wenn es mit der Performance nicht hinhaut, dann melde Dich noch einmal.
Dann muss ich mal schauen, ob ich es mit anderen Methoden lösen kann.


Hi Edgar, Silke hatte am Anfang erwähnt, dass sie nach Möglichkeit eine Lösung ohne Array-Formel sucht. Deswegen meinte ich, dass es mit Vergleich() und ohne Sortierung schwierig oder gar nicht funktionieren wird.

[BoskoBiati]

Hallo Atilla,

Silke hat nach einer Formel ohne Matrix gesucht, weil sie die Formel nicht per VBA umwandeln konnte. Momentan gibt es ja genug Lösungen, da kann sie sich ja aussuchen, was ihr am meisten zusagt.
Ich konnte allerdings in Deinem Code bei dem gezeigten Muster keinen Fehler entdecken, außer dass er erst in Zeile 3 anfing.

[atilla]

Hallo Edgar,

Ich konnte allerdings in Deinem Code bei dem gezeigten Muster keinen Fehler entdecken, außer dass er erst in Zeile 3 anfing

das ist richtig. In Zelle A2 sollte die Formel: =C2 & "01" stehen.
Da ich aber ab Zeile 2 die Werte in Spalte A lösche, muss ich das im Code noch korigieren und ab Zeile 3
löschen:

Code:

Sub numerieren_Ati_2()
   Dim i As Long, k As Long, j As Long
   Dim lngLetzte As Long
   Dim lngMax As Long
      lngLetzte = Cells(Rows.Count, 2).End(xlUp).Row
      Range("A3:A" & lngLetzte).ClearContents
      Application.ScreenUpdating = False
      For i = 2 To lngLetzte
         If Application.CountIf(Range("B1:B" & i - 1), Cells(i, 2)) = 0 Then
            If Application.CountIf(Range("C1:C" & i - 1), Cells(i, 3)) = 0 Then
               Cells(i, 1) = Cells(i, 3) & "01"
            Else
               For k = i - 1 To 2 Step -1
                  If Cells(k, 3) = Cells(i, 3) Then
                     If lngMax < Right(Cells(k, 1), 2) Then lngMax = Right(Cells(k, 1), 2)
                  End If
               Next k
               Cells(i, 1) = Cells(i, 3) & Format(lngMax + 1, "00")
               lngMax = 0
            End If
         Else
            j = Range("B2:B" & i - 1).Find(Cells(i, 2), lookat:=xlWhole).Row
            Cells(i, 1) = Cells(j, 1)
         End If
      Next i
      Application.ScreenUpdating = True
End Sub

oder ich schreibe den Wert für Zeile 2 gleich per Code rein:

Code:

Sub numerieren_Ati_2()
   Dim i As Long, k As Long, j As Long
   Dim lngLetzte As Long
   Dim lngMax As Long
      lngLetzte = Cells(Rows.Count, 2).End(xlUp).Row
      Range("A2:A" & lngLetzte).ClearContents
      Cells(2, 1) = Cells(i, 3) & "01"
      Application.ScreenUpdating = False
      For i = 2 To lngLetzte
         If Application.CountIf(Range("B1:B" & i - 1), Cells(i, 2)) = 0 Then
            If Application.CountIf(Range("C1:C" & i - 1), Cells(i, 3)) = 0 Then
               Cells(i, 1) = Cells(i, 3) & "01"
            Else
               For k = i - 1 To 2 Step -1
                  If Cells(k, 3) = Cells(i, 3) Then
                     If lngMax < Right(Cells(k, 1), 2) Then lngMax = Right(Cells(k, 1), 2)
                  End If
               Next k
               Cells(i, 1) = Cells(i, 3) & Format(lngMax + 1, "00")
               lngMax = 0
            End If
         Else
            j = Range("B2:B" & i - 1).Find(Cells(i, 2), lookat:=xlWhole).Row
            Cells(i, 1) = Cells(j, 1)
         End If
      Next i
      Application.ScreenUpdating = True
End Sub