🔧
ConvertCurrency
ユーティリティ通貨換算を行う
通貨換算を行うVBAマクロです。為替レートをシートのレートテーブルまたはWeb接続から取得し、指定した金額を別の通貨に変換します。複数通貨への一括変換や、選択範囲内のすべての金額を自動換算する処理も実装できます。VLOOKUP形式のレートテーブルを使ったオフライン換算と、Web参照を使ったリアルタイムレートへの対応の2方式が利用できます。内部ではレートテーブルをVLOOKUP形式で参照するオフライン方式と、Web経由で最新レートを取得するオンライン方式の2通りが実装可能で、業務要件に応じて選択できます。ConvertUnitsと同様の「変換系」マクロとして、経理・貿易実務の集計フローに組み込むと効果が高まります。手計算での換算ミスや電卓との数値転記ミスを根本的になくせる点が実務上の大きな価値です。
📖 使い方
- VBAエディタを開く（Alt + F11）
- モジュールを挿入（挿入 > モジュール）
- 下記VBAコードをコピー&ペースト
- ブック上で実行（Alt + F8 でマクロ選択）
💡 実行例： 実行すると金額と通貨の種類を選択して変換結果をクリップボードにコピー
🎯 活用シーン
- ✓海外取引の請求書金額を円換算した列を自動生成
- ✓複数通貨の経費精算データを一括でJPY換算してサマリー作成
- ✓為替レートテーブルを更新するだけで全シートの換算額が自動更新
- ✓海外子会社からの経費報告を本社の連結通貨（円）に統一換算して集計したいとき
- ✓多通貨で見積もりを提示する必要がある輸出案件で、レート変動時にも即座に再計算したいとき
💡 実装のヒント
- ▸レートテーブルをシートに持ちVLOOKUPで換算レートを参照します
- ▸WorksheetFunction.VLookupで通貨コードからレートを取得できます
- ▸小数点以下の丸め処理にはWorksheetFunction.Roundを使います
- ▸レートの更新頻度が高い場合は、レートテーブルの最終更新日時をセルに表示しておくと、古いレートでの誤算を防げます。
- ▸端数処理のルール（切り捨て・四捨五入）は経理基準に合わせてWorksheetFunction.Roundの引数で明確に指定してください。
💻 VBAコード
' ConvertCurrency
' -----------------
' Macro Name: ConvertCurrency
' Description: 通貨換算を行う
' Parameters: なし
' Returns: なし
' Usage: 実行すると金額と通貨の種類を選択して変換結果をクリップボードにコピー
' -----------------
Sub ConvertCurrency()
Dim currencyType As String
Dim inputAmount As Double
Dim resultAmount As Double
Dim fromCurrency As String
Dim toCurrency As String
Dim ws As Worksheet
Dim outputCell As String
On Error GoTo ErrorHandler
currencyType = InputBox("通貨ペアを選択:" & vbCrLf & _
"1: USD -> JPY" & vbCrLf & _
"2: JPY -> USD" & vbCrLf & _
"3: EUR -> JPY" & vbCrLf & _
"4: JPY -> EUR" & vbCrLf & _
"5: GBP -> JPY" & vbCrLf & _
"6: JPY -> GBP", "通貨換算", "1")
If currencyType = "" Then
Exit Sub
End If
inputAmount = InputBox("金額を入力:", "通貨換算")
If inputAmount = "" Then
Exit Sub
End If
If Not IsNumeric(inputAmount) Then
MsgBox "数値を入力してください。", vbExclamation
Exit Sub
End If
inputAmount = CDbl(inputAmount)
Dim rate As Double
Select Case currencyType
Case "1"
rate = 150
fromCurrency = "USD"
toCurrency = "JPY"
Case "2"
rate = 1 / 150
fromCurrency = "JPY"
toCurrency = "USD"
Case "3"
rate = 163
fromCurrency = "EUR"
toCurrency = "JPY"
Case "4"
rate = 1 / 163
fromCurrency = "JPY"
toCurrency = "EUR"
Case "5"
rate = 190
fromCurrency = "GBP"
toCurrency = "JPY"
Case "6"
rate = 1 / 190
fromCurrency = "JPY"
toCurrency = "GBP"
Case Else
MsgBox "無効な選択です。", vbExclamation
Exit Sub
End Select
resultAmount = inputAmount * rate
Set ws = ActiveSheet
outputCell = InputBox("結果を出力するセルアドレスを入力:", "通貨換算", "A1")
If outputCell <> "" Then
ws.Range(outputCell).Value = resultAmount
ws.Range(outputCell).NumberFormat = "#,##0.00"
End If
MsgBox inputAmount & " " & fromCurrency & " = " & Format(resultAmount, "#,##0.00") & " " & toCurrency, vbInformation
Dim clip As Object
Set clip = CreateObject("htmlfile").parentWindow.clipboardData
clip.SetData "text", Format(resultAmount, "#,##0.00") & " " & toCurrency
Exit Sub
ErrorHandler:
MsgBox "エラーが発生しました: " & Err.Description, vbCritical
End Sub