Registriert seit: 10.04.2014
Version(en): Office 2019
(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...
Gruß Jörg
ich muss mich erst wieder ganz langsam heran robben. Also bitte ich um Nachsicht
"Wer immer tut, was er schon kann, bleibt immer das, was er schon ist." - Henry Ford
Registriert seit: 14.04.2014
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
Registriert seit: 14.04.2014
Version(en): 2003, 2007
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.
Gruß Atilla
Registriert seit: 13.04.2014
Version(en): 365, 2019
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.
Gruß
Edgar
Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Registriert seit: 14.04.2014
Version(en): 2003, 2007
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
Gruß Atilla
|