Clever-Excel-Forum

Seiten: 1 2 3 4

(17.04.2014, 14:05)Silki schrieb: [ -> ]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...

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

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.

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.

Hallo Edgar,

Zitat: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

Seiten: 1 2 3 4

Jockel

Silki

atilla

BoskoBiati

atilla