セルに入力された単価の通貨記号別に合計を算出するには?

Question 72.1   Previous Next
数量と単価を入力したら合計値を算出するように設定したい

 ・単価の列には "\" と "US$"が混在
 ・合計値は "\"の列と "US$"の列に分かれている


( Excel 2000 & Windows XP )
Answer   Copyright (C) 2005.3.3 永井善王
上図は私が、ご質問のテキスト文からワークシートを再現したものですが、合っていますか? (CとD列には事前にセルの書式設定が 「通貨」または「会計」にしてある前提)
B列のセルに入力された単価の通貨記号が "\" の場合は C列に、"US$"の場合は D列に、数量に単価を乗じた金額をセットしたいということですね。

結論から申しますと、色々な方法があるかと思いますが、ここでは下記マクロをご紹介しておきます。
Sub 単価のセルの表示形式を調べて通貨別に合計する()
    開始行 = 2
    終了行 = 6
    Range("C" & 開始行 & ":D" & 終了行).ClearContents     '合計用セルをクリア
    For 行 = 開始行 To 終了行                              '2~6行について繰り返す
        表示形式 = Range("B" & 行).NumberFormatLocal      'セルの表示形式を取得
        On Error GoTo 円データなし                        'エラー処理ルーチンを有効に
        位置 = Application.WorksheetFunction.Find("\", 表示形式, 1)    '\を検索する
        Range("C" & 行).Value = Range("B" & 行).Value * Range("A" & 行) '単価×数量
        GoTo 次行へ

円データなし:
        Resume ドルチェック                         'エラー処理ルーチンを終了し実行再開
ドルチェック:
        On Error GoTo 次行へ
        位置 = Application.WorksheetFunction.Find("US$", 表示形式, 1)
        Range("D" & 行).Value = Range("B" & 行).Value * Range("A" & 行)

次行へ:
        On Error GoTo 0                             'エラー処理ルーチンを無効にする
    Next
End Sub
マクロが少し込み入っているのは、エラー処理ルーチンがあるからです。 以下の解説を参考にしてください。

NumberFormatLocalプロパティ
セルの通貨記号を知りたければ、まず、セルを指定して、NumberFormatLocalプロパティの値を取得します。するとセルの表示形式が文字列で返されます。 たとえば、B2セルの場合は、"\#,##0;[赤]\-#,##0" のように返ります。

FINDワークシート関数
次に、取得した文字列に "\" とか "US$" とかが含まれているかを検索します。 ここでは、FINDワークシート関数を利用して検索しています。
    FIND(検索文字列, 対象, 開始位置)
この関数は、見つかった場合はその文字位置を返してくれますが、見つからない場合はエラー値 #VALUE! を返すことになっています。 しかし、VBAで実行すると見つからない場合に実行時エラーが発生します から、エラー処理ルーチンを準備しておきます。

On Error Goto ステートメント
このステートメントは、引数に指定した行から始まるエラー処理ルーチンを有効にします。 ここでは、引数に「円データなし」という行ラベルを指定していますから、この後で実行するコードでエラーが発生すると、「円データなし」という行にプログラムの制御が移ります。
つまり、
6行目の NumberFormatLocalプロパティで取得した文字列 「表示形式」に "\" が含まれていない場合は、
8行目の FINDワークシート関数を実行するとエラーが発生して、
12行目の 「円データなし」という行にプログラムの制御が移るようになります。
13~16行目で同様にして "US$" の処理を行っています。

以上で回答を終わりますが、試してみた結果、あるいは、他の方法を考えられたりしたら、ご連絡いただけるとうれしいです。
ありがとうございました
早々のご回答ありがとうございました。
ここ数週間、この問題と格闘しておりましたので、大変助かりました。今まで手入力で行っていた作業がお蔭様で自動でできるようになりました。 ものすごい作業の効率化が図れました。
ありがとうございました。 以上、よろしくお願い致します。

 

Excel VBA Macro