🔧
ConvertUnits
ユーティリティ単位変換を行う
🎬 デモGIF準備中
📖 使い方
- VBAエディタを開く(Alt + F11)
- モジュールを挿入(挿入 > モジュール)
- 下記VBAコードをコピー&ペースト
- ブック上で実行(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