📊 Excel VBA Top100
🔧

ConvertUnits

ユーティリティ

単位変換を行う

🎬 デモGIF準備中

📖 使い方

  1. VBAエディタを開く(Alt + F11)
  2. モジュールを挿入(挿入 > モジュール)
  3. 下記VBAコードをコピー&ペースト
  4. ブック上で実行(Alt + F8 でマクロ選択)
💡 実行例: 実行すると変換元の値と単位の種類を選択して変換結果をクリップボードにコピー

💻 VBAコード

' ConvertUnits
' -----------------
' Macro Name: ConvertUnits
' Description: 単位変換を行う
' Parameters: なし
' Returns: なし
' Usage: 実行すると変換元の値と単位の種類を選択して変換結果をクリップボードにコピー
' -----------------

Sub ConvertUnits()
    Dim ws As Worksheet
    Dim unitType As String
    Dim inputValue As Double
    Dim resultValue As Double
    Dim resultUnit As String
    Dim outputCell As String

    On Error GoTo ErrorHandler

    unitType = InputBox("変換种类を選択:" & vbCrLf & _
                "1: 長さ (cm <-> inch)" & vbCrLf & _
                "2: 重さ (kg <-> lb)" & vbCrLf & _
                "3: 温度 (C <-> F)" & vbCrLf & _
                "4: 容積 (L <-> gal)", "単位変換", "1")

    inputValue = InputBox("変換元の値を入力:", "単位変換")

    If inputValue = "" Then
        Exit Sub
    End If

    If Not IsNumeric(inputValue) Then
        MsgBox "数値を入力してください。", vbExclamation
        Exit Sub
    End If

    inputValue = CDbl(inputValue)

    Select Case unitType
        Case "1"
            Dim direction1 As String
            direction1 = InputBox("変換方向:" & vbCrLf & "1: cm -> inch" & vbCrLf & "2: inch -> cm", "単位変換", "1")
            If direction1 = "1" Then
                resultValue = inputValue / 2.54
                resultUnit = "inch"
            Else
                resultValue = inputValue * 2.54
                resultUnit = "cm"
            End If
        Case "2"
            Dim direction2 As String
            direction2 = InputBox("変換方向:" & vbCrLf & "1: kg -> lb" & vbCrLf & "2: lb -> kg", "単位変換", "1")
            If direction2 = "1" Then
                resultValue = inputValue * 2.20462
                resultUnit = "lb"
            Else
                resultValue = inputValue / 2.20462
                resultUnit = "kg"
            End If
        Case "3"
            Dim direction3 As String
            direction3 = InputBox("変換方向:" & vbCrLf & "1: C -> F" & vbCrLf & "2: F -> C", "単位変換", "1")
            If direction3 = "1" Then
                resultValue = inputValue * 9 / 5 + 32
                resultUnit = "F"
            Else
                resultValue = (inputValue - 32) * 5 / 9
                resultUnit = "C"
            End If
        Case "4"
            Dim direction4 As String
            direction4 = InputBox("変換方向:" & vbCrLf & "1: L -> gal" & vbCrLf & "2: gal -> L", "単位変換", "1")
            If direction4 = "1" Then
                resultValue = inputValue / 3.78541
                resultUnit = "gal"
            Else
                resultValue = inputValue * 3.78541
                resultUnit = "L"
            End If
        Case Else
            MsgBox "無効な選択です。", vbExclamation
            Exit Sub
    End Select

    Set ws = ActiveSheet
    outputCell = InputBox("結果を出力するセル地址を入力:", "単位変換", "A1")

    If outputCell <> "" Then
        ws.Range(outputCell).Value = resultValue
        ws.Range(outputCell).NumberFormat = "0.##"
    End If

    MsgBox "変換結果: " & Format(resultValue, "0.##") & " " & resultUnit, vbInformation

    Dim clip As Object
    Set clip = CreateObject("htmlfile").parentWindow.clipboardData
    clip.SetData "text", Format(resultValue, "0.##") & " " & resultUnit
    Exit Sub

ErrorHandler:
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical
End Sub