Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

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:
Antworten 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);"")
Antworten 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
Antworten Top
#4
(08.02.2018, 10: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...
Antworten Top
#5
(08.02.2018, 11: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:
Antworten 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
Antworten 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
Antworten 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:
Antworten Top
#9
PERFEKT STEFL!!! That´s it!!! Merci!!! Good job! :19:
Antworten 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.
Antworten Top


Gehe zu:


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