Automatisches durchnummerieren VBA
#1
Hallo steh auf den Schlauch...


Habe folgendes Problem mit VBA:

In einem Worksheet steht in Spalte O entweder "Aktiv" oder "Beendet" und in Spalte P immer "Werk 1" oder "Werk 2".
Wenn in Spalte O "aktiv" und in Spalte P "Werk 1" steht, dann möchte ich dass in Spalte C alle Zeilen die die Bedingungen aus Spalte O und P erfüllen von 1 bis X durchnummeriert werden.

Habe jetzt schon etliche Versuche durch und komme zu keinem funktionierenden Ergebnis. :16:

Hoffe dass mir ein schlaues Hirn von Euch helfen kann.

Vielen Dank vorab!!! :17:
Top
#2
Hi,

leider Verrätst du nicht wo deine Daten beginnen und warum VBA.

Bsp für Daten ab Zeile 4.
C4    =WENN((O4="Aktiv")*(P4="Werk 1");1+MAX($C$3:C3);"")
Top
#3
Hallo,

vielleicht so?
Code:
Sub prcMasi()
   Dim rngTreffer As Range
   Dim lngC As Long
  
   With Worksheets("Tabelle1")   'Tabellenname anpassen!
      'Spalte C wird gelöscht
      .Columns(3).ClearContents
      Set rngTreffer = .Columns(15).Find("aktiv", LookIn:=xlValues, lookat:=xlWhole)
      'falls in aktiv gefunden wird
      If Not rngTreffer Is Nothing Then
         If rngTreffer.Offset(0, 1) = "Werk1" Then
            lngC = lngC + 1
            .Cells(rngTreffer.Row, 3) = lngC
         End If
      End If
   End With
End Sub
Gruß Stefan
Win 10 / Office 2016
Top
#4
(08.02.2018, 11:29)Elex schrieb: Hi,

leider Verrätst du nicht wo deine Daten beginnen und warum VBA.

Bsp für Daten ab Zeile 4.
C4    =WENN((O4="Aktiv")*(P4="Werk 1");1+MAX($C$3:C3);"")

Hallo Elex,

danke für dein Bemühen, aber so bekomme ich das auch hin.
Es muss VBA sein und es spielt auch keine Rolle wo die Daten beginnen...
Top
#5
(08.02.2018, 12:42)Steffl schrieb: Hallo,

vielleicht so?
Code:
Sub prcMasi()
  Dim rngTreffer As Range
  Dim lngC As Long
 
  With Worksheets("Tabelle1")   'Tabellenname anpassen!
     'Spalte C wird gelöscht
     .Columns(3).ClearContents
     Set rngTreffer = .Columns(15).Find("aktiv", LookIn:=xlValues, lookat:=xlWhole)
     'falls in aktiv gefunden wird
     If Not rngTreffer Is Nothing Then
        If rngTreffer.Offset(0, 1) = "Werk1" Then
           lngC = lngC + 1
           .Cells(rngTreffer.Row, 3) = lngC
        End If
     End If
  End With
End Sub
Hallo Steffl
Einen ähnlichen Ansatz hatte ich auch schon...
Leider funktioniert so nur .clearContents
Ich weiß die Sache is etwas kniffliger... :19:
Top
#6
Hallo,

es sollte eigentlich nur ein Eintrag erfolgen, da mein Makro doch noch fehlerhaft war.

Code:
Sub prcMasi()
   Dim rngTreffer As Range
   Dim lngC As Long
   Dim strAdresse As String
  
   With Worksheets("Tabelle1")   'Tabellenname anpassen!
      'Spalte C wird gelöscht
      .Columns(3).ClearContents
      Set rngTreffer = .Columns(15).Find("aktiv", LookIn:=xlValues, lookat:=xlWhole)
      'falls in aktiv gefunden wird
      If Not rngTreffer Is Nothing Then
         strAdresse = rngTreffer.Address
         Do
            If rngTreffer.Offset(0, 1) = "Werk1" Then
               lngC = lngC + 1
               .Cells(rngTreffer.Row, 3) = lngC
            End If
            Set rngTreffer = .Columns(15).FindNext(rngTreffer)
         Loop While rngTreffer.Address <> strAdresse
      End If
   End With
End Sub
Gruß Stefan
Win 10 / Office 2016
[-] Folgende(r) 1 Nutzer sagt Danke an Steffl für diesen Beitrag:
  • MasiGepetto
Top
#7
Ok dann VBA.

Code:
Sub Zählen()
Dim Zeile, k As Long

Sheets("Tabelle1").Range("C2:C10000").ClearContents
Zeile = 2
k = 1
Do
If Cells(Zeile, 15) & Cells(Zeile, 16) = "AktivWerk 1" Then
   Cells(Zeile, 3) = k
   k = k + 1
End If
Zeile = Zeile + 1
Loop While Zeile < 10000 And Cells(Zeile, 15) <> ""
End Sub
Top
#8
Danke Elex, funktioniert aber leider auch noch nicht bis auf die .clearcontents :(,

Optimalerweise würde ich gerne diese Formel über einen OptionButton ausführen

=WENN(UND(O:O="AKTIV";P:P=SVERWEIS(WAHR;actions!B$4:C$5;2;FALSCH));catch!C1+1;catch!C1)

damit ich aus der entstandenen Durchnummerierung automatisch eine Liste befüllen kann.

Funktioniert alles noch nich so ganz :19: :16:
Top
#9
PERFEKT STEFL!!! That´s it!!! Merci!!! Good job! :19:
Top
#10
Hi MasiGepetto,

Beide Codes liefern das gleiche Ergebnis wenn die Schreibweise passt.
Ich weiss nicht ob du Werk1 oder Werk 1 schreibst und aktiv oder Aktiv. Aber die Anpassung hatte ich dir Zugetraut.

Bei großen Datenmengen ist der Code von Steffl. spürbar schneller.
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste