VBA – Excel – převod na litry

Jedná se zde o jednoduchou úlohu z programování pro studenty. Úkolem je převést množství tekutiny zadané v ml, l a hl na l.

Naprogramovaná událost na tlačítko využívá funkce Mid() pro separaci množství a jednotek. Dále je zde využita funkce InStr() pro zjištění pozice mezery, jako oddělovače.

Pro rozlišení jednotek je zde použita konstrukce Select Case.

Zdrojový kód ve Visual Basic for Application

Převod na litry u jedné konkrétní buňky

Private Sub CommandButtonPrevodLitryJP_Click()
    Text = Range("A1").Text
    PoziceMezery = InStr(Text, " ")
    Mnozstvi = Mid(Text, 1, PoziceMezery - 1)
    Jednotky = Mid(Text, PoziceMezery + 1, Len(Text))
    
    Select Case Jednotky
        Case "ml"
            MnozstviVLitrech = Mnozstvi / 1000
        Case "l"
            MnozstviVLitrech = Mnozstvi
        Case "hl"
            MnozstviVLitrech = Mnozstvi * 100
    End Select
    
    Range("B1").Value = MnozstviVLitrech & " l"
End Sub

Převod vícero buněk

Private Sub CommandButtonPrevodLitryJT_Click()
    Dim PoziceMezery As Integer
    Dim Text, Jednotky As String
    Dim Mnozstvi, MnozstviVLitrech As Double
    
    For Each Bunka In Range("A1:A6")
        Text = Bunka.Text
        PoziceMezery = InStr(Text, " ")
        Mnozstvi = Mid(Text, 1, PoziceMezery - 1)
        Jednotky = Mid(Text, PoziceMezery + 1, Len(Text))
        
        Select Case Jednotky
            Case "ml"
                MnozstviVLitrech = Mnozstvi / 1000
            Case "l"
                MnozstviVLitrech = Mnozstvi
            Case "hl"
                MnozstviVLitrech = Mnozstvi * 100
        End Select
        
        Bunka.Offset(0, 1).Value = MnozstviVLitrech & " l"
    Next Bunka
End Sub

Převod vícero buněk včetně správného formátování jednotek

Private Sub CommandButtonPrevodLitryJZ_Click()
    Dim PoziceMezery As Integer
    Dim Text, Jednotky As String
    Dim Mnozstvi, MnozstviVLitrech As Double
    
    For Each Bunka In Range("A1:A6")
        Text = Bunka.Text
        PoziceMezery = InStr(Text, " ")
        Mnozstvi = Mid(Text, 1, PoziceMezery - 1)
        Jednotky = Mid(Text, PoziceMezery + 1, Len(Text))
        
        Select Case Jednotky
            Case "ml"
                MnozstviVLitrech = Mnozstvi / 1000
            Case "l"
                MnozstviVLitrech = Mnozstvi
            Case "hl"
                MnozstviVLitrech = Mnozstvi * 100
        End Select
        
        Bunka.Offset(0, 1).NumberFormat = "#,##0.00 l"
        Bunka.Offset(0, 1).Value = MnozstviVLitrech
        
    Next Bunka
End Sub

Zdrojový soubor

prevod-na-litry.xlsm