Tag Archives: select case

Etunollien lisääminen makrojen avulla

Hävinneet etunollat voidaan lisätä jälkikäteen helposti myös makroja käyttäen.

Ohessa esimerkki postinumeroista.
Olen jakanut toiminnon kahtia:
1. SUB-toimintosarja:
KorjaaPnro käy läpi valitun alueen FOR EACH … NEXT silmukassa ja kutsuu
2. Function-toimintosarjaa:
LisääEtuNollat, joka taas lisää tarvittavat etunollat sille annettuun merkkijonoon ja palauttaa korjatun postinumeron sitä kutsuvalle SUB-toimintosarjalle.

Sub KorjaaPnro()
 'valitaan ensin alue ja käynnistetään sen jälkeen makro
    Dim rngS As Range
    For Each rngS In Selection         'muotoillaan solu tekstiksi
       rngS.NumberFormat = "@"         'kuts.funkt.joka lisää tarvittavat
                                       'etunollat
       rngS = LisääEtuNollat(rngS.Value)
    Next
 End Sub
Function LisääEtuNollat(PNro As String) As String
 'funktion tarkistaa sille annetun merkkijonon pituuden Len -funktiolla
 'tämän jälkeen piituudesta riippuen lisätään etunollat
 'nollien lisäämisessä voidaan myös käyttää muotoa "'0000", eli heitto merkki 'ensimmäiseksi
      Select Case (Len(PNro))
        Case 1
          LisääEtuNollat = "0000" & PNro
        Case 2
          LisääEtuNollat = "000" & PNro
        Case 3
          LisääEtuNollat = "00" & PNro
        Case 4
          LisääEtuNollat = "0" & PNro
        Case Else
          LisääEtuNollat = PNro
        End Select
 End Function

Suomenkieliset kuukaudet englanniksi

Itselleni tulee aika usein esiin tilanteita, että jo tehdystä taulusta tulisi muuttaa kuukauden nimet suomesta englanniksi, esimerkiksi kun olen ryhmitellyt Pivot-taulukossa päivämäärät kuukausiksi.

Tein makron, jonka suoritan aina tarvittaessa.
Tallensin makron omaan apuohjelma-makrotyökirjaan, jonka avaan aina tarvittaessa.

Alla kaksi esimerkkiä makrosta.
Ensimmäinen on (Sub Replace_Fin_Months_With_Eng), jossa valitsen ensin alueen ja sitten suoritan makron. Toinen on (Sub Replace_Fin_Months_With_Eng_v2), jossa makro kysyy muunnettavaa aluetta.
Molemmissa makroissa käytän FOR EACH NEXT silmukkaa, jolloin vältyn hitaasta SELECT-käskystä.

Sub Replace_Fin_Months_With_Eng()
'2013 / BI
'Replace finnish month namnes with english
'Select first cells and then run makro
    Dim c As Range
    For Each c In Selection
        Select Case c.Value
            Case "tammi"
                c.Value = "Jan"
            Case "helmi"
                c.Value = "Feb"
            Case "maalis"
                c.Value = "Mar"
            Case "huhti"
                c.Value = "Apr"
            Case "touko"
                c.Value = "May"
            Case "kesä"
                c.Value = "Jun"
            Case "heinä"
                c.Value = "Jul"
            Case "elo"
                c.Value = "Aug"
            Case "syys"
                c.Value = "Sep"
            Case "loka"
                c.Value = "Oct"
            Case "marras"
                c.Value = "Nov"
            Case "joulu"
                c.Value = "Dec"
        End Select
    Next
End Sub

Sub Replace_Fin_Months_With_Eng_v2()
'2013 / BI
'Replace finnish month namnes with english
'Makro that asks what range should be converted

    Dim c As Range
    On Error Resume Next
    Set c = Application.InputBox("Valitse alue joka muunnetaan", _
        "Kuukausien vaihto", , , , , , 8)
    On Error GoTo 0
    If Not c Is Nothing Then
        c.Select
        For Each c In Selection
            Select Case LCase(c.Value)
                Case "tammi"
                    c.Value = "Jan"
                Case "helmi"
                    c.Value = "Feb"
                Case "maalis"
                    c.Value = "Mar"
                Case "huhti"
                    c.Value = "Apr"
                Case "touko"
                    c.Value = "May"
                Case "kesä"
                    c.Value = "Jun"
                Case "heinä"
                    c.Value = "Jul"
                Case "elo"
                    c.Value = "Aug"
                Case "syys"
                    c.Value = "Sep"
                Case "loka"
                    c.Value = "Oct"
                Case "marras"
                    c.Value = "Nov"
                Case "joulu"
                    c.Value = "Dec"
            End Select
        Next
    End If
End Sub