Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen

Nummernkreis hochzählen m.verb.Zellen

Betrifft: Nummernkreis hochzählen m.verb.Zellen von: Angelika
Geschrieben am: 25.05.2020 10:36:55

hallo
ich habe dank Karl Heinz einen Code auf meinem Command Button. Funktioniert einwandfrei.
Und zwar werden die Werte in Spalte B immer um eins erhöht.Das funktioniert super wenn nur
eine Zelle gefüllt ist. Wenn ich aber die letzte Zelle mit mehreren Zellen verbinde ( also z.B. Zelle 377 bis 380 ist verbunden ) dann funktioniert es nicht mehr.
Kann mir bitte jemand helfen hier der ursprüngliche Code von Karl Heinz :

Sub Nummernkreis()

 Dim iNr As Integer
 Dim sAA As String, svAA As String, stAA As String
 svAA = ",SP,SCM,SA,PM,PR,QS,RD,TE,"
 stAA = "1=SP 2=SCM 30=SA 4=PM 5=PR 6=QS 7=RD 8=TE"
 With ActiveCell
  If .Column = 2 And .Row > 13 Then
Nochmal:
   sAA = InputBox("Bitte die Abforderungsabteilung oder Nr eingeben!" & vbCr & stAA, " _
Anforderungsabteilung", "SP")
   If StrPtr(sAA) = 0 Then Exit Sub
   sAA = UCase$(sAA)
   If Val(sAA) > 0 Then
     sAA = Split(svAA, ",")(Val(sAA))
   ElseIf InStr(svAA, "," & sAA & ",") = 0 Then
      GoTo Nochmal
   End If
   iNr = Val(Left$(.Offset(-1, 0).Value & "    ", 4)) + 1
   .Value = Right$("0000" & CStr(iNr), 4) & "-" & sAA & Format(Date, "-dd-mm-yyyy")
  End If
 End With
End Sub
Danke Angelika

Betrifft: AW: Nummernkreis hochzählen m.verb.Zellen
von: volti
Geschrieben am: 25.05.2020 11:05:30

Hallo Angelika,

teste mal, ob Dir nachfolgender code weiterhilft:

Code in die Zwischenablage
Sub Nummernkreis()
 Dim iNr As Integer, i As Integer
 Dim sAA As String, svAA As String, stAA As String
 svAA = ",SP,SCM,SA,PM,PR,QS,RD,TE,"
 stAA = "1=SP 2=SCM 30=SA 4=PM 5=PR 6=QS 7=RD 8=TE"
 With ActiveCell
  If .Column = 2 And .Row > 13 Then
Nochmal:
   sAA = InputBox("Bitte die Abforderungsabteilung oder Nr eingeben!" & vbCr & stAA, " Anforderungsabteilung", "SP")
   If StrPtr(sAA) = 0 Then Exit Sub
   sAA = UCase$(sAA)
   If Val(sAA) > 0 Then
     sAA = Split(svAA, ",")(Val(sAA))
   ElseIf InStr(svAA, "," & sAA & ",") = 0 Then
      GoTo Nochmal
   End If
   For i = .Row - 1 To 13 Step -1
    If Cells(i, .Column).value <> "" Then Exit For
   Next
   iNr = Val(Left$(Cells(i, .Column).value & "    ", 4)) + 1
   .value = Right$("0000" & CStr(iNr), 4) & "-" & sAA & Format(Date, "-dd-mm-yyyy")
  End If
 End With
End Sub
viele Grüße
Karl-Heinz


Betrifft: AW: Nummernkreis hochzählen m.verb.Zellen
von: Angelika
Geschrieben am: 25.05.2020 11:55:25

hallo Karl Heinz

ich danke Dir für Deine schnelle und perfekte Lösung. Das hätte ich nicht hinbekommen.
einen wunderschönen Tag wünsch ich Dir. Bleib Gesund
Angelika

Beiträge aus dem Excel-Forum zum Thema "Nummernkreis hochzählen m.verb.Zellen "