Just nu i M3-nätverket
Gå till innehåll

Excel VBA formatering i löpnummerserie


Tommy H
 Share

Rekommendera Poster

Hej!

Jag har gjort en löpnummerloop där jag via inputboxar kan styra hur numret ska se ut.

Det fungerar bra men jag missar en "nolla" i sista strängen.

Jag vill ha det enligt följande: 

stÅr: 2st siffror

stMånad: 2st siffror

stLöpnummer: 3st siffror. Det är här som det blir tokigt i slutsträngen.

Börjar löpnummerserien på t.ex 97, så vill jag att det i st5rängen ska stå XXXX097.

Nollan som kommer före löpnumret "försvinner!

Hur löser man det?

 

    Sub Mata_In_Löpnummer()

    Dim stÅr As String
    Dim stMånad As String
    Dim stLöpnummer As Integer
    Dim stAntal As Integer
    Dim WsMontageanvisning As Worksheet
    Dim i As Integer
    Set WsMontageanvisning = Worksheets("Mont.anvisn Std")


        stÅr = Application.InputBox("Ange Årtalet:", _
        "Årtal 2st siffror", Type:=1)
        stMånad = Application.InputBox("Ange Månaden:", _
        "Månaden med siffror", Type:=1)
        stLöpnummer = Application.InputBox("Första löpnumret:", _
        "Första Löpnummer", Type:=1)
        stAntal = Application.InputBox("Hur många Löpnummer:", _
        "Antal Löpnummer", Type:=1)
        
        If Len(stMånad) < 2 Then
            stMånad = "0" & stMånad
        End If
        
    Do Until i = stAntal
            If Len(stLöpnummer) < 4 Then
                stLöpnummer = "0" & stLöpnummer
            End If
                Range("D6").Formula = stÅr & stMånad & i + stLöpnummer
            i = i + 1
    Loop

    End Sub

 

/Tommy

Länk till kommentar
Dela på andra webbplatser

Hej!

6 timmar sedan, skrev Tommy H:

Det fungerar bra men jag missar en "nolla" i sista strängen.

Detta beror troligen på att du har den deklarerat som en Integet och inte en sträng. Excel visar inte nollor framför ett tal. Testa att mata in t.ex. 0004 i en cell och Excel kommer ändra detta till 4. Om cellen är formatterad som text kommer de inledande nollorna att finnas kvar

 

Prova följande kod, men med ändringar i din Loop samt lagt till några If satser

Do Until i = stAntal
	If Len(stLöpnummer) < 4 Then
		stLöpnummer = stLöpnummer + 1
	End If
	i = i + 1
Loop
                           
If stLöpnummer < 100 Then
	Range("D6").Formula = stÅr & stMånad & 0 & CStr(stLöpnummer)
Else
	Range("D6").Formula = stÅr & stMånad & CStr(stLöpnummer)
End If

År och Månad är deklarerade som String i din kod. Jag konverterar stLöpnummer till String innan den konkatineras med År och Månad samt lägger till 0 framför om den är mindre än 100.

 

Testa gärna och hör av dig om hur det gick

 

 

  • Gilla 1
Länk till kommentar
Dela på andra webbplatser

41 minuter sedan, skrev Automan:

Hej!

Detta beror troligen på att du har den deklarerat som en Integet och inte en sträng. Excel visar inte nollor framför ett tal. Testa att mata in t.ex. 0004 i en cell och Excel kommer ändra detta till 4. Om cellen är formatterad som text kommer de inledande nollorna att finnas kvar

 

Prova följande kod, men med ändringar i din Loop samt lagt till några If satser


Do Until i = stAntal
	If Len(stLöpnummer) < 4 Then
		stLöpnummer = stLöpnummer + 1
	End If
	i = i + 1
Loop
                           
If stLöpnummer < 100 Then
	Range("D6").Formula = stÅr & stMånad & 0 & CStr(stLöpnummer)
Else
	Range("D6").Formula = stÅr & stMånad & CStr(stLöpnummer)
End If

År och Månad är deklarerade som String i din kod. Jag konverterar stLöpnummer till String innan den konkatineras med År och Månad samt lägger till 0 framför om den är mindre än 100.

 

Testa gärna och hör av dig om hur det gick

Det fungerade utmärkt!

Jag gillar det där att man "lurar" koden med en annan funktion som du gör med stLöpnummer <100!

Tack för hjälpen!

41 minuter sedan, skrev Automan:

 

 

 

Länk till kommentar
Dela på andra webbplatser

42 minuter sedan, skrev MH_:

**ED**

Märkligt att alla ignorerar frågan i 7 timmar och sen får du två svar samtidigt

/**ED**

 

 

Kolla in FORMAT i VBA. Det är som TEXT()-formeln i excel

Format function (Visual Basic for Applications) | Microsoft Docs

dvs du ersätter 

            If Len(stLöpnummer) < 4 Then
                stLöpnummer = "0" & stLöpnummer
            End If
                Range("D6").Formula = stÅr & stMånad & i + stLöpnummer

med

Range("D6").value= stÅr & stMånad & Format(i + stLöpnummer, "000")

 

Men koden ser fortfarande lite konstig ut. Skall du alltid skriva i D6 eller skall den fortsätta nedåt?

Det här är ett exempel där dina löpnummer skrivs in i D6 och nedåt


 Sub Mata_In_Löpnummer2()

    Dim stÅr As String
    Dim stMånad As String
    Dim stLöpnummer As Integer
    Dim stAntal As Integer
    Dim WsMontageanvisning As Worksheet
    Dim i As Integer
    Set WsMontageanvisning = Worksheets("Mont.anvisn Std")

        stÅr = Format(Application.InputBox("Ange Årtalet:", _
        "Årtal 2st siffror", Type:=1), "00")
        
        stMånad = Format(Application.InputBox("Ange Månaden:", _
        "Månaden med siffror", Type:=1), "00")
        
        stLöpnummer = Application.InputBox("Första löpnumret:", _
        "Första Löpnummer", Type:=1)
        
        stAntal = Application.InputBox("Hur många Löpnummer:", _
        "Antal Löpnummer", Type:=1)

'städa bort saker som redan står i D6 och ner
Range(WsMontageanvisning.Range("D6"), WsMontageanvisning.Range("D6").End(xlDown)).ClearContents
    
    i = 0
    Do Until i = stAntal
            WsMontageanvisning.Range("D6").Offset(i).Value = stÅr & stMånad & Format(i + stLöpnummer, "000")
            i = i + 1
    Loop

    End Sub

 

En annan variant är att använda excel inbyggda formler. Exempelvis så här:

=TEXT(B1;"00")&TEXT(B2;"00")&TEXT(SEKVENS(B4;;B3);"000")

Då kan du även se till att man bar får ha 12 månader och 99 år med hjälp av 

DATA->dataverifiering

 

sekvens.jpg.92535fecba65906a2372f481b4f80808.jpg

 

Tackar för detta svaret också!

Allt ska skrivas i D6!

Tanken är att det ska in en utskrift också i loopen, så att det skrivs ut ett dokument med sitt unika löpnummer!

Länk till kommentar
Dela på andra webbplatser

  • 3 veckor senare...

Hej igen!

Det går framåt ?

Nu har jag bara ett problem kvar som ligger en bit ner i koden!

Hur löser man det att man måste göra ett val i Litboxen?

Dvs. koden ska ej gå vidare innan det finns ett val!

 

Private Sub CommandButton1_Click()
'Kör
    Dim stPrefix As String
    Dim stÅr As String
    Dim stMånad As String
    Dim targetcell, target As String
    Dim stLöpnummer As String
    Dim stAntal As Integer
    Dim WsTarget As Worksheet
    Dim i, j, k As Integer
    Dim ValdaBlad As String
    
            Set WsTarget = ActiveSheet
        'Inmatning av målcell
            targetcell = Application.InputBox("Målcellen:", _
            "t.ex D6", Type:=2)
            TextBox1 = targetcell
        
        'Inmatning av inledande sträng
            stPrefix = Application.InputBox("Ange Prefix:", _
            "Inledande text/nummer", Type:=2)
            TextBox2 = stPrefix
        
        'Inmatning av årtal
            stÅr = Application.InputBox("Ange Årtalet:", _
            "Årtal 2st siffror", Type:=1)
            TextBox2 = stPrefix & stÅr
        
        'Inmatning av månad
            stMånad = Application.InputBox("Ange Månaden:", _
            "Månaden med siffror", Type:=1)
        'Om månaden endast innehåller en siffra, så lägg en nolla framför
        If Len(stMånad) < 2 Then
            stMånad = "0" & stMånad
        End If
            TextBox2 = stPrefix & stÅr & stMånad
        
        'Inmatning av första löpnumret
            stLöpnummer = Application.InputBox("Första löpnumret:", _
            "Första Löpnummer", Type:=1)
        
        If Len(stLöpnummer) < 10 Then
               stLöpnummer = "0" & "0" & stLöpnummer
        ElseIf stLöpnummer < 100 Then
               stLöpnummer = "0" & stLöpnummer
        End If
            TextBox2 = stPrefix & stÅr & stMånad & stLöpnummer
        
        'Inmatning av antal löpnummer
            stAntal = Application.InputBox("Hur många Löpnummer:", _
            "Antal Löpnummer", Type:=1)
            TextBox3 = stAntal
        
        'Listar upp alla bladflikar i Excelfilen
        With ListBox1
            .Clear
            For j = 1 To ActiveWorkbook.Sheets.Count
                .AddItem ActiveWorkbook.Sheets(j).Name
            Next j
        End With
    
  
 Här måste användaren göra ett val i Listbox1!

Jag får inte riktigt till det, för koden bara passerar utan att man har gjort ett aktivt val!
  
  
  

    For k = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(k) Then
            ValdaBlad = ListBox1.List(k) & "," & ValdaBlad
        End If
    Next k
        If ValdaBlad = "" Then
                MsgBox "Inget blad är markerat, avslutar!"
                ListBox1.Clear
                UserForm2.Hide
                Exit Sub
        End If
        
                ValdaBlad = Left(ValdaBlad, Len(ValdaBlad) - 1)
                Sheets(Split(ValdaBlad, ",")).Select
                WsTarget.Activate
                WsTarget.Range(targetcell).NumberFormat = "@"
        
    Do Until i = stAntal
                  i = i + 1
            
                WsTarget.Range(targetcell).NumberFormat = "@"
                WsTarget.Range(targetcell).Value = (stPrefix & stÅr & stMånad & CStr(stLöpnummer))
                ActiveWindow.SelectedSheets.PrintOut
    Loop

ListBox1.Clear
UserForm2.Hide

End Sub

Länk till kommentar
Dela på andra webbplatser

 Share

×
×
  • Skapa nytt...