『海外送金の同項目の自動入力と計算』（愛子）
海外送金のデータ入力を引継ぐことになりました。
3つの関連したファイルを開き双方の関連データを計算します。
いちいちファイルを入れ替えて見ながら差額計算をしたり違うファイルから
データを見たりと煩雑な為に1つのファイルに3つの表を作成しました。
シート名は、”Sheet1”のままにしています。
まずは、3つの表の項目名と行列を説明します。
次にマクロでお願いする事を記載しています。
そして最後に3つの表の項目名を貼り付けます。
よろしくお願いします。
１つのシートに3つのフォームがあります。
左から、計算書 正式通関 簡易通関
1，計算書の範囲は、Ａ列からＪ列まで Ｋ列は余白です。
項目名は、5行目です。項目名は、Ａ列送金日、 Ｂ列銀行名、
Ｃ列送金先、Ｄ列送金額/＄、Ｅ列Rate/\、Ｆ列円換算、Ｇ列手数料/Charge、
Ｈ列ｺﾙﾚｽ手数料、Ｉ列合計、Ｊ列計算書送金額と正式通関、簡易通関との差額
２，正式通関の範囲は、Ｌ列からＸ列 Ｙは余白です。
項目名は、5行目です。項目名は、申告年月日Ｍ列、商品仕入先Ｎ列、通関業者Ｎ列、B/L・インボイス No.Ｏ列、輸入金額（＄）Ｐ列
輸入金額（￥）Ｑ列、運賃＄Ｒ列、運賃￥＄Ｓ列、送金日Ｔ列、支払方法Ｕ列、
一部支払額ドル/値引きＶ列、rate＄Ｗ列、仕入＄＋運賃＄の小計Ｘ列。
３，簡易通関の範囲は、Ｚ列からＡＬ迄
項目名は、5行目です。（正式通関と同じです）
項目名は、申告年月日Ｚ列、商品仕入ＡＡ列、通関業者ＡＢ列、B/L・インボイス No.ＡＣ列、輸入金額（＄）ＡＤ列 輸入金額（￥）ＡＥ列、運賃＄ＡＦ列、運賃￥＄ＡＧ列、送金日ＡＨ列、支払方法ＡＩ列、
一部支払額ドル/値引きＡＪ列、rate＄ＡＫ列、仕入＄＋運賃＄の小計ＡＬ列。
手入力の箇所は、申告年月日、商品仕入先、通関業者、ｂ/ｌインボイスＮｏ.
輸入＄と運賃＄です。
提案：
下記は、マクロで処理して頂きたい内容です。
1，正式通関と簡易通関の項目で、計算書と同じ項目があれば
計算書の項目をマクロで転記
2，正式のＸ列と簡易のＡＬ列の小計は、輸入金額＄+運賃＄を計算します。
正式と簡易のデータが複数件ある場合には、複数件の最後のデータの
Ｘ列とＡＬ列の小計の右列（Y列とＡＭ列）に合計を入れてください。
正式と簡易のデータの範囲の認識は、例えば、一回目のデータは、一件分を6行目に入力します。2回目のデータは、1回目の最後のデータ（下記値引表示と値引き＄）の次に空白を一行あけて、その次の行から2回目のデータをいれます。
即ち詰めた行を1つのグループとします。
計算書と正式と簡易の始めのデータは、同じ行とします。
その1つのグループ（空白が出る迄）を対象に計算書から
同じ項目のデータを導きます。
計算書・正式通関・簡易通関で
空白の次の行から、次のデータを手入力します。
例えば、正式通関で一件のデータを6行目に入れたとします。
次の7行目のＵ列にマクロで「値引き」の文字を表示（色も黄色をつけます）していただき
7行目の正式Ｖ列の項目、一部支払い/値引き欄に
次の値引き＄の計算をマクロでお願いします。（この値引き＄の計算が最後のデータとなります。）
値引き＄＝計算書のＤ列送金額＄－Ｘ列の合計－ＡＬ列の合計
3，正式と簡易の輸入金額￥と運賃￥の計算は、マクロで輸入金額＄✕計算書のＥ列のrateです。そして運賃＄✕Ｅ列のrateです。
4，マクロで計算書からＴ列及びＡＨ列の送金日とＷ列とＡＫ列のRate/＄を導き、そしてＵ列とＨＩ列の支払方法欄に「三井住友/梅田」の文字を自動入力して頂けますか？
3つの表を貼り付けます。
計算書
送金日 銀行名 送金先 送金額/＄ Rate/\ 円換算 手数料/Charge ｺﾙﾚｽ手数料 合計 計算書送金額と正式、簡易との差額
2025/5/1 三井住友銀行 ＡＢＣＤ 1,453.00 143.16 208,011 2,500 2,500
正式通関
仕入 運賃 申告年月日 商品仕入先 通関業者 B/L・インボイス No. 輸入金額($) 輸入金額(\) 運賃($) 運賃(\) 送金日 支払方法 一部支払額/値引き Rate/$ 小計 2025/4/27 ＡＢＣＤ ＴＴＴ 52481354 5,000.00 30
簡易通関
仕入 運賃 申告年月日 商品仕入先 通関業者 B/L・インボイス No. 輸入金額($) 輸入金額(\) 運賃($) 運賃(\) 送金日 支払方法 一部支払額/値引き Rate/$ 小計 2025/4/11 ＡＢＣＤ ＷＷＷ 7334202 72.40 30.00
以上です
沢山あり申し訳ありませんが、よろしくお願いします。
＜ 使用 Excel：Microsoft365、使用 OS：Windows11 ＞
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim i As Long, startRow As Long
startRow = 6 ' データ開始行
Do While startRow <= lastRow
If WorksheetFunction.CountA(ws.Range("A" & startRow & ":J" & startRow)) = 0 Then
startRow = startRow + 1
Continue Do
End If
' グループの最終行を探す（空白行まで）
Dim endRow As Long
endRow = startRow
Do While WorksheetFunction.CountA(ws.Range("A" & endRow & ":J" & endRow)) > 0
endRow = endRow + 1
Loop
endRow = endRow - 1
' 小計、合計初期化
Dim totalFormalUSD As Double, totalSimplifiedUSD As Double
totalFormalUSD = 0
totalSimplifiedUSD = 0
Dim sendAmount As Double, rate As Double
sendAmount = ws.Cells(startRow, "D").Value
rate = ws.Cells(startRow, "E").Value
' 正式通関: 小計 (X列), 合計 (Y列)
Dim r As Long
For r = startRow To endRow
If IsNumeric(ws.Cells(r, "P").Value) And IsNumeric(ws.Cells(r, "R").Value) Then
ws.Cells(r, "X").Value = ws.Cells(r, "P").Value + ws.Cells(r, "R").Value
totalFormalUSD = totalFormalUSD + ws.Cells(r, "X").Value
ws.Cells(r, "Q").Value = ws.Cells(r, "P").Value * rate
ws.Cells(r, "S").Value = ws.Cells(r, "R").Value * rate
ws.Cells(r, "T").Value = ws.Cells(startRow, "A").Value
ws.Cells(r, "U").Value = "三井住友/梅田"
ws.Cells(r, "W").Value = rate
End If
Next r
ws.Cells(endRow, "Y").Value = totalFormalUSD
' 簡易通関: 小計 (AL列), 合計 (AM列)
Dim totalSimplifiedRow As Long
For r = startRow To endRow
If IsNumeric(ws.Cells(r, "AD").Value) And IsNumeric(ws.Cells(r, "AF").Value) Then
ws.Cells(r, "AL").Value = ws.Cells(r, "AD").Value + ws.Cells(r, "AF").Value
totalSimplifiedUSD = totalSimplifiedUSD + ws.Cells(r, "AL").Value
ws.Cells(r, "AE").Value = ws.Cells(r, "AD").Value * rate
ws.Cells(r, "AG").Value = ws.Cells(r, "AF").Value * rate
ws.Cells(r, "AH").Value = ws.Cells(startRow, "A").Value
ws.Cells(r, "AI").Value = "三井住友/梅田"
ws.Cells(r, "AK").Value = rate
End If
Next r
ws.Cells(endRow, "AM").Value = totalSimplifiedUSD
' 計算書J列: 差額（送金額 - 正式合計 - 簡易合計）
ws.Cells(startRow, "J").Value = sendAmount - totalFormalUSD - totalSimplifiedUSD
' 値引き行追加（1行下）
Dim discountRow As Long
discountRow = endRow + 1
ws.Cells(discountRow, "U").Value = "値引き"
ws.Cells(discountRow, "U").Interior.Color = RGB(255, 255, 0) ' 黄色
ws.Cells(discountRow, "V").Formula = "=" & sendAmount & "-" & totalFormalUSD & "-" & totalSimplifiedUSD
startRow = discountRow + 2 ' 次のグループ（1行空けて）
Loop
MsgBox "処理が完了しました。", vbInformation
End Sub
✅ このマクロの使い方
ExcelでAlt + F11 → Visual Basic for Applicationsを開く
挿入 > モジュール で新規モジュールを作成
上記コードを貼り付けて保存
Excelに戻り、Alt + F8 → 海外送金処理マクロ を実行！
💡補足と注意点
D列（送金額）やE列（Rate）は空白不可です。
値引き額は「送金額－正式－簡易」の計算結果になります。
合計の入る列：正式はY列、簡易はAM列
グループの区切りは空白行で判断しています。
「値引き」行の背景は黄色に塗られます
（通りすがり） 2025/07/13(日) 10:45:22
マクロを実行しましたら
構文エラーが出ました。構文始めから９行目です。よろしくお願いします。
Continue Do です。 （愛子） 2025/07/13(日) 11:52:02
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim i As Long, startRow As Long
startRow = 6 ' データ開始行
Do While startRow <= lastRow
' 空行なら次の行へ
If WorksheetFunction.CountA(ws.Range("A" & startRow & ":J" & startRow)) = 0 Then
startRow = startRow + 1
Else
' グループの最終行を探す（空白行まで）
Dim endRow As Long
endRow = startRow
Do While WorksheetFunction.CountA(ws.Range("A" & endRow & ":J" & endRow)) > 0
endRow = endRow + 1
Loop
endRow = endRow - 1
' 小計、合計初期化
Dim totalFormalUSD As Double, totalSimplifiedUSD As Double
totalFormalUSD = 0
totalSimplifiedUSD = 0
Dim sendAmount As Double, rate As Double
sendAmount = ws.Cells(startRow, "D").Value
rate = ws.Cells(startRow, "E").Value
' 正式通関: 小計 (X列), 合計 (Y列)
Dim r As Long
For r = startRow To endRow
If IsNumeric(ws.Cells(r, "P").Value) And IsNumeric(ws.Cells(r, "R").Value) Then
ws.Cells(r, "X").Value = ws.Cells(r, "P").Value + ws.Cells(r, "R").Value
totalFormalUSD = totalFormalUSD + ws.Cells(r, "X").Value
ws.Cells(r, "Q").Value = ws.Cells(r, "P").Value * rate
ws.Cells(r, "S").Value = ws.Cells(r, "R").Value * rate
ws.Cells(r, "T").Value = ws.Cells(startRow, "A").Value
ws.Cells(r, "U").Value = "三井住友/梅田"
ws.Cells(r, "W").Value = rate
End If
Next r
ws.Cells(endRow, "Y").Value = totalFormalUSD
' 簡易通関: 小計 (AL列), 合計 (AM列)
For r = startRow To endRow
If IsNumeric(ws.Cells(r, "AD").Value) And IsNumeric(ws.Cells(r, "AF").Value) Then
ws.Cells(r, "AL").Value = ws.Cells(r, "AD").Value + ws.Cells(r, "AF").Value
totalSimplifiedUSD = totalSimplifiedUSD + ws.Cells(r, "AL").Value
ws.Cells(r, "AE").Value = ws.Cells(r, "AD").Value * rate
ws.Cells(r, "AG").Value = ws.Cells(r, "AF").Value * rate
ws.Cells(r, "AH").Value = ws.Cells(startRow, "A").Value
ws.Cells(r, "AI").Value = "三井住友/梅田"
ws.Cells(r, "AK").Value = rate
End If
Next r
ws.Cells(endRow, "AM").Value = totalSimplifiedUSD
' 計算書J列: 差額（送金額 - 正式合計 - 簡易合計）
ws.Cells(startRow, "J").Value = sendAmount - totalFormalUSD - totalSimplifiedUSD
' 値引き行追加（1行下）
Dim discountRow As Long
discountRow = endRow + 1
ws.Cells(discountRow, "U").Value = "値引き"
ws.Cells(discountRow, "U").Interior.Color = RGB(255, 255, 0) ' 黄色
ws.Cells(discountRow, "V").Formula = "=" & sendAmount & "-" & totalFormalUSD & "-" & totalSimplifiedUSD
' 次のグループへ（1行空けて）
startRow = discountRow + 2
（通りすがり） 2025/07/13(日) 13:02:52
値引き額は「送金額－正式－簡易」の計算結果になります。
合計の入る列：正式はY列、簡易はAM列
グループの区切りは空白行で判断しています。
「値引き」行の背景は黄色に塗られます
必要に応じて以下も追加可能です：
値引きがマイナスになったときの警告
複数計算書行に対応（今回のスコープでは1行前提）
ご希望あれば調整します。お試しのうえ、気になる点があればお知らせください。
（通りすがり） 2025/07/13(日) 13:04:34
なんだかLLMっぽい人ですね。 （なんだか） 2025/07/13(日) 13:19:23
構文の最後がend subが切れていましたので、勝手にその前の最後を真似して
MsgBox "処理が完了しました。", vbInformation End Sub を入れましたらifブロックに対応する end ifが有りませんとでました。
すみませんがよろしくお願いします。
（愛子） 2025/07/13(日) 13:42:49
Loop
End If
MsgBox "処理が完了しました。", vbInformation
End Sub
（はてな） 2025/07/13(日) 15:09:01
はてな 様
フォロー、ありがとうございました
（通りすがり） 2025/07/13(日) 15:15:06
Loop
End If
MsgBox "処理が完了しました。", vbInformation
End Sub
と入力して実行しますと
LOOPに対応するDoが有りませんと出ました。
Doをどこにつけて良いかがわかりませんので、よろしくお願いします。
（愛子） 2025/07/13(日) 15:27:56
End If
Loop
MsgBox "処理が完了しました。", vbInformation
End Sub
でした
（はてな） 2025/07/13(日) 15:51:46
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim startRow As Long
startRow = 6 ' データ開始行
Do While startRow <= lastRow
' 空行なら次の行へ
If WorksheetFunction.CountA(ws.Range("A" & startRow & ":J" & startRow)) = 0 Then
startRow = startRow + 1
Else
' グループの最終行を探す（空白行まで）
Dim endRow As Long
endRow = startRow
Do While WorksheetFunction.CountA(ws.Range("A" & endRow & ":J" & endRow)) > 0
endRow = endRow + 1
Loop
endRow = endRow - 1
' 小計、合計初期化
Dim totalFormalUSD As Double, totalSimplifiedUSD As Double
totalFormalUSD = 0
totalSimplifiedUSD = 0
Dim sendAmount As Double, rate As Double
sendAmount = ws.Cells(startRow, "D").Value
rate = ws.Cells(startRow, "E").Value
Dim r As Long
' 正式通関: 小計 (X列), 合計 (Y列)
For r = startRow To endRow
If IsNumeric(ws.Cells(r, "P").Value) And IsNumeric(ws.Cells(r, "R").Value) Then
ws.Cells(r, "X").Value = ws.Cells(r, "P").Value + ws.Cells(r, "R").Value
totalFormalUSD = totalFormalUSD + ws.Cells(r, "X").Value
ws.Cells(r, "Q").Value = ws.Cells(r, "P").Value * rate
ws.Cells(r, "S").Value = ws.Cells(r, "R").Value * rate
ws.Cells(r, "T").Value = ws.Cells(startRow, "A").Value
ws.Cells(r, "U").Value = "三井住友/梅田"
ws.Cells(r, "W").Value = rate
End If
Next r
ws.Cells(endRow, "Y").Value = totalFormalUSD
' 簡易通関: 小計 (AL列), 合計 (AM列)
For r = startRow To endRow
If IsNumeric(ws.Cells(r, "AD").Value) And IsNumeric(ws.Cells(r, "AF").Value) Then
ws.Cells(r, "AL").Value = ws.Cells(r, "AD").Value + ws.Cells(r, "AF").Value
totalSimplifiedUSD = totalSimplifiedUSD + ws.Cells(r, "AL").Value
ws.Cells(r, "AE").Value = ws.Cells(r, "AD").Value * rate
ws.Cells(r, "AG").Value = ws.Cells(r, "AF").Value * rate
ws.Cells(r, "AH").Value = ws.Cells(startRow, "A").Value
ws.Cells(r, "AI").Value = "三井住友/梅田"
ws.Cells(r, "AK").Value = rate
End If
Next r
ws.Cells(endRow, "AM").Value = totalSimplifiedUSD
' 計算書J列: 差額
ws.Cells(startRow, "J").Value = sendAmount - totalFormalUSD - totalSimplifiedUSD
' 値引き行追加（1行下）
Dim discountRow As Long
discountRow = endRow + 1
ws.Cells(discountRow, "U").Value = "値引き"
ws.Cells(discountRow, "U").Interior.Color = RGB(255, 255, 0) ' 黄色
ws.Cells(discountRow, "V").Formula = "=" & sendAmount & "-" & totalFormalUSD & "-" & totalSimplifiedUSD
' 次のグループへ（1行空けて）
startRow = discountRow + 2
End If
Loop
MsgBox "処理が完了しました。", vbInformation
End Sub
（通りすがり） 2025/07/13(日) 16:28:23
はてな様
有難うございます。
通りすがり様
全て私が願っている提案を完璧に作成していただき大喜びでした。
あらゆる処の計算、銀行名、差額の計算、値引きの表示、値引き＄の計算、他。小計の合計まで有難いです。
１つだけ、お願いがあります。
急ぎませんので。 色々な箇所で計算された数値、税理士さん、私も他の皆さんも含めて
この数値はどこからきたものでしょうかと尋ねられても答えれますように
数式でお願い出来ますでしょうか？ 式にマウスを当てはめたら解りますので。
かって言ってすみません。よろしくお願いします。
私ごとで恐縮ですが、目を酷使をして左目の白色のところが真っ赤になっています。
明日、眼科に行きます。故にしばらく目を休めたいと思っていますので。
落ち着きましたら複数件のデータを実行します。
その時にはよろしくお願いします。
本当に嬉しいです。
（愛子） 2025/07/13(日) 16:48:08
excel
コピーする
編集する
=COUNTIFS(P4:P105,"*", U4:U105,"<>")
💬 説明（口頭で説明する時の言い方の例）
「P列に「*」が入っていて、U列が空欄じゃない行数を数えています」
✅ N103 に入れる数式
「P列に「*」があり、U列が空欄で、かつ V列には入力がある」行の数を数える式
excel
コピーする
編集する
=COUNTIFS(P4:P105,"*", U4:U105,"", V4:V105,"<>")
💬 説明（口頭で説明する時の言い方の例）
「P列に「*」があって、U列は空欄で、V列には何か入力されている行数をカウントしています」
✅ 数式の可読性を上げる工夫（オプション）
もし、数式が埋もれてしまって分かりづらくなるようなら、補助列を用意して条件に合うかどうか TRUE/FALSE で出す方法もあります。
これにより、目視でも確認でき、税理士さんにも説明しやすくなります。
たとえば：
| Q列（"G103対象"）に入れる式（Q4〜Q105） |
excel
コピーする
編集する
=AND(P4="*", U4<>"")
| R列（"N103対象"）に入れる式（R4〜R105） |
excel
コピーする
編集する
=AND(P4="*", U4="", V4<>"")
そして、
G103には =COUNTIF(Q4:Q105, TRUE)
N103には =COUNTIF(R4:R105, TRUE)
とすれば、「この行がなぜ数えられたのか」を 見て・確認して・説明できる 仕組みになります。
（通りすがり） 2025/07/13(日) 20:08:35
の、３行は特に意味がないので無視してください。
（通りすがり） 2025/07/13(日) 20:11:29
Sub ログ再作成()
Dim srcWs As Worksheet '元データのシート
Dim logWs As Worksheet 'ログのシート
Dim i As Long, lastRow As Long
Dim rowNum As Long
Dim pVal As Variant, uVal As Variant, vVal As Variant
Dim target As String, reason As String
Dim gCount As Long, nCount As Long
Set srcWs = ThisWorkbook.Sheets("Sheet1") '元のデータシート名
Set logWs = ThisWorkbook.Sheets("ログ") 'ログ出力用シート名
'ログシートを初期化（1行目だけ残す）
logWs.Cells.ClearContents
logWs.Range("A1:D1").Value = Array("行番号", "対象セル", "条件一致", "理由")
lastRow = srcWs.Cells(srcWs.Rows.Count, "P").End(xlUp).Row
rowNum = 2
gCount = 0
nCount = 0
For i = 4 To lastRow
pVal = srcWs.Cells(i, "P").Value
uVal = srcWs.Cells(i, "U").Value
vVal = srcWs.Cells(i, "V").Value
If pVal = "*" Then
If uVal <> "" Then
target = "G103"
reason = "Pに*あり・U入力あり"
gCount = gCount + 1
ElseIf vVal <> "" Then
target = "N103"
reason = "Pに*あり・U空白・V入力あり"
nCount = nCount + 1
Else
target = "-"
reason = "Pに*あり・UもVも空欄"
End If
Else
target = "-"
reason = "Pに*なし"
End If
logWs.Cells(rowNum, 1).Value = i
logWs.Cells(rowNum, 2).Value = target
logWs.Cells(rowNum, 3).Value = IIf(target = "G103" Or target = "N103", "TRUE", "FALSE")
logWs.Cells(rowNum, 4).Value = reason
rowNum = rowNum + 1
Next i
'G103とN103に結果を書き込み
srcWs.Range("G103").Value = gCount
srcWs.Range("N103").Value = nCount
MsgBox "ログを再作成しました！", vbInformation
End Sub
✅ 最後に
「どうしてこの数値なのか」を説明する機能が クリックひとつで再作成されるので、
・税理士さん向け
・社内レビュー資料
・自分の確認ミス防止
などにとっても効果的です！
（通りすがり） 2025/07/13(日) 20:13:37
ごめんなさい。全然、違うの貼り付けてしまいました・・・。
ログ記録マクロ（チェック＆記録）
Sub ログ再作成()
Dim srcWs As Worksheet
Dim logWs As Worksheet
Dim i As Long, lastRow As Long
Dim rowNum As Long
Dim pVal As Variant, uVal As Variant, vVal As Variant
Dim target As String, reason As String
Dim gCount As Long, nCount As Long
Set srcWs = ThisWorkbook.Sheets("Sheet1")
Set logWs = ThisWorkbook.Sheets("ログ")
' ログシート初期化（1行目ヘッダー残す）
logWs.Cells.ClearContents
logWs.Range("A1:D1").Value = Array("行番号", "対象セル", "条件一致", "理由")
lastRow = srcWs.Cells(srcWs.Rows.Count, "P").End(xlUp).Row
rowNum = 2
gCount = 0
nCount = 0
For i = 4 To lastRow
pVal = srcWs.Cells(i, "P").Value '正式通関の輸入金額($)列
uVal = srcWs.Cells(i, "U").Value '正式通関の支払方法列
vVal = srcWs.Cells(i, "V").Value '正式通関の値引き列
If pVal = "*" Then
If uVal <> "" Then
target = "G103"
reason = "Pに*あり・U入力あり"
gCount = gCount + 1
ElseIf vVal <> "" Then
target = "N103"
reason = "Pに*あり・U空白・V入力あり"
nCount = nCount + 1
Else
target = "-"
reason = "Pに*あり・UもVも空欄"
End If
Else
target = "-"
reason = "Pに*なし"
End If
logWs.Cells(rowNum, 1).Value = i
logWs.Cells(rowNum, 2).Value = target
logWs.Cells(rowNum, 3).Value = IIf(target = "G103" Or target = "N103", "TRUE", "FALSE")
logWs.Cells(rowNum, 4).Value = reason
rowNum = rowNum + 1
Next i
' カウント結果をSheet1のG103とN103に出力
srcWs.Range("G103").Value = gCount
srcWs.Range("N103").Value = nCount
MsgBox "ログを再作成しました！", vbInformation
End Sub
ゆっくりでよいので実行おねがいします。
目を、しっかり休めてくださいね(⌒∇⌒)
（通りすがり） 2025/07/13(日) 20:33:07
✅ 最後に
「どうしてこの数値なのか」を説明する機能が クリックひとつで再作成されるので、
・税理士さん向け
・社内レビュー資料
・自分の確認ミス防止
などにとっても効果的です！
（通りすがり） 2025/07/13(日) 20:35:56
項目 シート・列 備考 送金日 計算書 A列 手入力または元データから 銀行名 計算書 B列 手入力 送金先 計算書 C列 手入力 送金額（ドル） 計算書 D列 手入力、計算書の基準となる送金額 Rate（ドル円換算率） 計算書 E列 手入力、計算の基準となるレート 輸入金額（ドル） 正式通関 P列、簡易通関 AD列 手入力 運賃（ドル） 正式通関 R列、簡易通関 AF列 手入力 輸入金額（円） 正式通関 Q列、簡易通関 AE列 マクロ計算（輸入ドル × 計算書レート） 運賃（円） 正式通関 S列、簡易通関 AG列 マクロ計算（運賃ドル × 計算書レート） 小計（ドル） 正式通関 X列、簡易通関 AL列 マクロ計算（輸入ドル + 運賃ドル） 小計合計（ドル） 正式通関 Y列、簡易通関 AM列 マクロ計算（グループ内のX列/AL列の合計） 差額 計算書 J列 マクロ計算（送金額 － 正式小計合計 － 簡易小計合計） 支払方法 正式通関 U列、簡易通関 AI列 マクロ自動入力「三井住友/梅田」 値引き（ドル） 正式通関 V列 マクロ計算（送金額 － 正式小計合計 － 簡易小計合計）
何度もすいません。
あまりにも、体裁が悪かったので申し訳ないです
（通りすがり） 2025/07/13(日) 20:46:42
ところで、正式通関を利用した2件、簡易通関を利用した1件、 これら3件合計の計算書が1行などということは無いのですか？
説明可能性の観点から言ったら、数値はexplicitには一切使わず、 すべて数式を埋め込む、ということになるんでしょうか?
（xyz） 2025/07/13(日) 23:13:33
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim startRow As Long: startRow = 6
Do While startRow <= lastRow
' 空行ならスキップ
If WorksheetFunction.CountA(ws.Range("A" & startRow & ":J" & startRow)) = 0 Then
startRow = startRow + 1
Else
' グループ終わりを判定
Dim endRow As Long: endRow = startRow
Do While WorksheetFunction.CountA(ws.Range("A" & endRow & ":J" & endRow)) > 0
endRow = endRow + 1
Loop
endRow = endRow - 1
' 小計（正式X列、簡易AL列）
Dim r As Long
For r = startRow To endRow
ws.Cells(r, "X").Formula = "=P" & r & "+R" & r
ws.Cells(r, "AL").Formula = "=AD" & r & "+AF" & r
' 円換算（正式Q/S列、簡易AE/AG列）
ws.Cells(r, "Q").Formula = "=P" & r & "*E" & startRow
ws.Cells(r, "S").Formula = "=R" & r & "*E" & startRow
ws.Cells(r, "AE").Formula = "=AD" & r & "*E" & startRow
ws.Cells(r, "AG").Formula = "=AF" & r & "*E" & startRow
' 送金日・支払方法・Rate
ws.Cells(r, "T").Formula = "=A" & startRow
ws.Cells(r, "AH").Formula = "=A" & startRow
ws.Cells(r, "U").Value = "三井住友/梅田"
ws.Cells(r, "AI").Value = "三井住友/梅田"
ws.Cells(r, "W").Formula = "=E" & startRow
ws.Cells(r, "AK").Formula = "=E" & startRow
Next r
' 合計（正式Y列、簡易AM列）
ws.Cells(endRow, "Y").Formula = "=SUM(X" & startRow & ":X" & endRow & ")"
ws.Cells(endRow, "AM").Formula = "=SUM(AL" & startRow & ":AL" & endRow & ")"
' 差額（計算書J列）
ws.Cells(startRow, "J").Formula = "=D" & startRow & "-Y" & endRow & "-AM" & endRow
' 値引き行
Dim discountRow As Long: discountRow = endRow + 1
ws.Cells(discountRow, "U").Value = "値引き"
ws.Cells(discountRow, "U").Interior.Color = RGB(255, 255, 0)
ws.Cells(discountRow, "V").Formula = "=D" & startRow & "-Y" & endRow & "-AM" & endRow
' 次グループへ
startRow = discountRow + 2
End If
Loop
MsgBox "数式で計算処理完了！", vbInformation
End Sub
そういうことでしたか。勘違いしました…
（通りすがり） 2025/07/14(月) 14:45:00
7/1414：45のマクロを実行しました
。その前のログ再作成を楽しみ実行しましたが、私の貼り付けがわるかったのか
構文には色がつかずにエラーが出ました。（マクロ名のあたしにエラーが、なんと書かれてあったかは
忘れました。すみません。
そうしている間に本日のマクロを実行しましたら
表示も計算式網羅されていまして嬉しかったです。
数値の処は、全て計算式が入っていました。
有難うございました。
ただ、差額＄の円がＱ７に入っていませんでした。
よろしくお願いします。
このマクロは、当初記載されていましたように、対象は、一件のデータのみですね。
計算ションに一件追加、正式通関と簡易通関にデータを複数件試しに入力して
マクロを実行しましたが、変化はなかったです。
複数のデータのマクロもお願いしてもよろしでしょうか？
（愛子） 2025/07/14(月) 21:46:01
Dim srcWs As Worksheet, logWs As Worksheet
Dim lastRow As Long, rowNum As Long, i As Long
Dim pVal As Variant, uVal As Variant, vVal As Variant
Dim gCount As Long, nCount As Long
Dim target As String, reason As String
Set srcWs = ThisWorkbook.Sheets("Sheet1")
Set logWs = ThisWorkbook.Sheets("ログ")
' ログシート初期化
logWs.Cells.ClearContents
logWs.Range("A1:D1").Value = Array("行番号", "対象セル", "条件一致", "理由")
lastRow = srcWs.Cells(srcWs.Rows.Count, "P").End(xlUp).Row
rowNum = 2
gCount = 0: nCount = 0
For i = 6 To lastRow
pVal = srcWs.Cells(i, "P").Value
uVal = srcWs.Cells(i, "U").Value
vVal = srcWs.Cells(i, "V").Value
If pVal = "*" Then
If uVal <> "" Then
target = "G103"
reason = "P列*あり、U列入力あり"
gCount = gCount + 1
ElseIf vVal <> "" Then
target = "N103"
reason = "P列*あり、U空白・V列入力あり"
nCount = nCount + 1
Else
target = "-"
reason = "P列*あり、U・V空白"
End If
Else
target = "-"
reason = "P列*なし"
End If
logWs.Cells(rowNum, 1).Value = i
logWs.Cells(rowNum, 2).Value = target
logWs.Cells(rowNum, 3).Value = IIf(target = "G103" Or target = "N103", "TRUE", "FALSE")
logWs.Cells(rowNum, 4).Value = reason
rowNum = rowNum + 1
Next i
' 件数カウント反映
srcWs.Range("G103").Value = gCount
srcWs.Range("N103").Value = nCount
MsgBox "ログ記録を更新しました", vbInformation
End Sub
これを、再度実行してみてください
（通りすがり） 2025/07/14(月) 22:44:29
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim startRow As Long: startRow = 6
Do While startRow <= lastRow
' 空行スキップ
If WorksheetFunction.CountA(ws.Range("A" & startRow & ":J" & startRow)) = 0 Then
startRow = startRow + 1
Else
' グループ終端を特定
Dim endRow As Long: endRow = startRow
Do While WorksheetFunction.CountA(ws.Range("A" & endRow & ":J" & endRow)) > 0
endRow = endRow + 1
Loop
endRow = endRow - 1
' 複数行数式入力
Dim r As Long
For r = startRow To endRow
' 正式通関
ws.Cells(r, "X").Formula = "=P" & r & "+R" & r
ws.Cells(r, "Q").Formula = "=P" & r & "*E" & startRow
ws.Cells(r, "S").Formula = "=R" & r & "*E" & startRow
ws.Cells(r, "T").Formula = "=A" & startRow
ws.Cells(r, "U").Value = "三井住友/梅田"
ws.Cells(r, "W").Formula = "=E" & startRow
' 簡易通関
ws.Cells(r, "AL").Formula = "=AD" & r & "+AF" & r
ws.Cells(r, "AE").Formula = "=AD" & r & "*E" & startRow
ws.Cells(r, "AG").Formula = "=AF" & r & "*E" & startRow
ws.Cells(r, "AH").Formula = "=A" & startRow
ws.Cells(r, "AI").Value = "三井住友/梅田"
ws.Cells(r, "AK").Formula = "=E" & startRow
Next r
' 小計合計
ws.Cells(endRow, "Y").Formula = "=SUM(X" & startRow & ":X" & endRow & ")"
ws.Cells(endRow, "AM").Formula = "=SUM(AL" & startRow & ":AL" & endRow & ")"
' 計算書：差額
ws.Cells(startRow, "J").Formula = "=D" & startRow & "-Y" & endRow & "-AM" & endRow
' 値引き行追加
Dim discountRow As Long: discountRow = endRow + 1
ws.Cells(discountRow, "U").Value = "値引き"
ws.Cells(discountRow, "U").Interior.Color = RGB(255, 255, 0)
ws.Cells(discountRow, "V").Formula = "=D" & startRow & "-Y" & endRow & "-AM" & endRow
' 次のグループへ（空白行1行飛ばし）
startRow = discountRow + 2
End If
Loop
MsgBox "全グループ数式処理が完了しました！", vbInformation
End Sub
（通りすがり） 2025/07/14(月) 22:47:13
質問者さんへ | ところで、正式通関を利用した2件、簡易通関を利用した1件、 | これら3件合計の計算書が1行などということは無いのですか？ | | 説明可能性の観点から言ったら、数値はexplicitには一切使わず、 | すべて数式を埋め込む、ということになるんでしょうか? これにご返事いただけなかったのは残念でした。
テスト検証の材料にもなるので、複数のデータのサンプルを提示されたらいかがですか？ 実際に担当してもいない者が想像するようなことではなく、質問者さんが提示されるのが間違いないと思います。 また実際にそうしたことをする過程で仕様の修正に気づくことも結構あります。(過去の経験から） 二度手間にならないように、ご自身で提示してください。
(1) 少なくともどんなパターンがありうるのかくらいは説明すべきかなと思います。 例えば、簡易通関（と計算書）だけがあるケースもあるんですか？こうしたことは部外者にはわかりません。 その場合でも、値引き額は、正式通関のエリアに書くのですか？ また、正式通関が1件、簡易通関が2件あったとき、値引き額はどの行に書くのですか？ それらもわかるように示してください。
(2) また必要な空行は正確に挿入されている前提でいいんですね？
(3) なお、これも今更ですが、日ごとにシートは変わるので、 計算書は常に６行目から始まると考えていいんですね。 それとも、開始行をその都度指定して、データ自体は追加していくパターンもありうるのですか？
============================= これだけだと何なので、勝手解釈版を載せておきます。 実行するのはmainマクロです。
=== ↓ここから === Option Explicit Dim ws As Worksheet
Sub main()
Dim k As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
For k = 6 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
If ws.Cells(k, "A") > 0 Then
Call oneGroup処理(k)
End If
Next
MsgBox "全グループ数式処理が完了しました！", vbInformation
End Sub
Sub oneGroup処理(k As Long)
Dim startRow&
Dim r&
Dim endRow1&, endRow2&
Dim flag1 As Boolean, flag2 As Boolean
Dim discountRow&
startRow = k
' 正式通関
r = startRow
Do While Cells(r, "L") > 0
flag1 = True
ws.Cells(r, "X").Formula = "=P" & r & "+R" & r
ws.Cells(r, "Q").Formula = "=P" & r & "*$E" & startRow
ws.Cells(r, "S").Formula = "=R" & r & "*$E" & startRow
ws.Cells(r, "T").Formula = "=A" & startRow
ws.Cells(r, "U").Value = "三井住友/梅田"
ws.Cells(r, "W").Formula = "=E" & startRow
r = r + 1
Loop
endRow1 = r - 1
' 簡易通関
r = startRow
Do While Cells(r, "Z") > 0
flag2 = True
ws.Cells(r, "AL").Formula = "=AD" & r & "+AF" & r
ws.Cells(r, "AE").Formula = "=AD" & r & "*$E" & startRow
ws.Cells(r, "AG").Formula = "=AF" & r & "*$E" & startRow
ws.Cells(r, "AH").Formula = "=A" & startRow
ws.Cells(r, "AI").Value = "三井住友/梅田"
ws.Cells(r, "AK").Formula = "=E" & startRow
r = r + 1
Loop
endRow2 = r - 1
' 小計合計
If flag1 Then ws.Cells(endRow1, "Y").Formula = "=SUM(X" & startRow & ":X" & endRow1 & ")"
If flag2 Then ws.Cells(endRow2, "AM").Formula = "=SUM(AL" & startRow & ":AL" & endRow2 & ")"
' 計算書：差額
ws.Cells(startRow, "J").Formula = "=D" & startRow _
& IIf(flag1, "-Y" & endRow1, "") _
& IIf(flag2, "-AM" & endRow2, "")
' 値引き行追加
discountRow = Application.Max(endRow1, endRow2) + 1
''discountRow = endRow1 + 1 'かも知れません。不明
ws.Cells(discountRow, "U").Value = "値引き"
ws.Cells(discountRow, "U").Interior.Color = RGB(255, 255, 0)
ws.Cells(discountRow, "V").Formula = "=D" & startRow _
& IIf(flag1, "-Y" & endRow1, "") _
& IIf(flag2, "-AM" & endRow2, "")
End Sub
=== ↑ここまで ===
# 通りすがりさんの提示されたコードを大幅にお借りしてます。 （xyz） 2025/07/15(火) 09:12:51
私の依頼にすぐに答えていただき感謝いたします。
ここで記載するようなことではありませんが、
左目の白い球が真っ赤になっていまして
昨日、眼科に行きました。傷はないとのことで安心しましたが、
目を休めていました。
提示されている２件のマクロを後日実行しまして
報告いたしますので勝手言いますがもう少し
お待ちください。
・・・・・・・・・・・・
ｘｙｚ様、今拝見しました。
お宅様の言われること全てその通りだとおもいます。
複数なら複数件、実際に表にあらわしてから、ここはこのようにして頂きたいと
お伝えするのが本筋だと思います。
言い訳になりますが、冒頭に私の提案を記載しました。
沢山まとまりのない提示を通りすがり様は、理解していただき、私の思うように
全て一件のデータのみとして細部にわたり作成されましたので
それ以上深く考えていませんでした。
２回目で複数のデータのマクロを実行してから違いがあれば依頼するつもりでいました。
説明可能性の観点から言ったら、数値はexplicitには一切使わず、
| すべて数式を埋め込む、ということになるんでしょうか? これにご返事いただけなかったのは残念でした。
これを読んだときには最初、意味がわからなかったのです。私は、最初に式を入れてくださいといいました。通りすがり様がその説明を対してログ記録再作成がありますと言われていましたので
通りすがり様へのの質問かと思っていました。質問者へと言われて再度読み返えすと
理解できました、失礼しました。
そして提案で終えるのではなく、マクロも備えていただき有難うございました。
通りすがり様そして
ｘｙｚ様
配慮がたらず本当に申し訳ございませんでした。
最初に述べましたように
少し時間をください。
（愛子） 2025/07/15(火) 10:18:21
遅くなって申し訳ございませんでした。
ログ記録再作成のマクロを実行しましたら
下記のエラーが出ました。
Set logWs = ThisWorkbook.Sheets("ログ")
正式通関に２行、簡易通関３行のデータを入れまして
マクロを実行しましたらどちらも自動での入力は表示されませんでした。
よろしくお願いします。
ｘｙｚ様
私の思いをさとっていただき有難うございました。
値引きと同じ行のＱ列に値引き＄にたいする円が入っていませんでした。
（愛子） 2025/07/15(火) 18:53:01
細切れに言われても困ります。データと想定結果を併せて提示して下さい。 それを実現するように修正しますので。 （xyz） 2025/07/15(火) 19:37:10
表の投稿にあたっては、 こちらにある有志の作成したツールが便利かもしれません。 [[20110209184943]] 『[談]シートレイアウトの投稿どうしてますか？』（ｍｏｍｏ） ３つのエリア別に表示してもらうとよいでしょう。 （xyz） 2025/07/15(火) 19:59:07
下記のデータを送りました。一旦おくります・
xyz様
下記のデータでお解りになられますか？
想定結果です。値引き＄の円換算額はＱ列７行目の式です。
Ｑ列 Ｕ列 Ｖ列
仕入 運賃
輸入金額($) 輸入金額(\) 運賃($) 運賃(\) 送金日 支払方法 一部支払額/値引き
6,699.00 959,028.84 20 2,863.20 2025/5/1 三井住友/梅田
７行目=V7*E6 値引き -5,368.40
（愛子） 2025/07/15(火) 20:14:03
表の投稿にあたっては、 こちらにある有志の作成したツールが便利かもしれません。 [[20110209184943]] 『[談]シートレイアウトの投稿どうしてますか？』（ｍｏｍｏ） ３つのエリア別に表示してもらうとよいでしょう。
教えていただいているのに、見ましたが、具体的にどうすれば良いかわかりません。
表の項目名を最初にどこに入れるかがわかりません。
（愛子） 2025/07/15(火) 20:20:54
そのマクロをご自分のブックにコピーして、 実行すると尋ねてくるので、それに答えるだけです。 ・対象とする範囲の指定 ・そのうち値ではなく、もし数式にしたいところがあれば、そのセル範囲の指定 です。 （元のシートは一切触らないので安心です。）
処理が終わったらクリップボードにテキストがコピーされているので、 メモ帳（でもお使いのエディターでもよい）にコピーすれば下書きができあがります。 （もちろん、こちらのコメント返信欄に直接貼り付けてもいいですね）
ちなみに、値引き＄の円換算額の話は、最初の「提案：」のどこに書かれていることなんですか？ 見逃しているのでしょうけど、念のため教えてください。
（xyz） 2025/07/15(火) 20:32:51
シート「ログ」がなければ作成
正式通関（L列～X列）、簡易通関（Z列～AL列）どちらも確認
複数行グループ対応
Sub ログ記録_修正版()
Dim srcWs As Worksheet, logWs As Worksheet
Dim lastRow As Long, i As Long, rowNum As Long
Dim pVal, uVal, vVal
Dim gCount As Long, nCount As Long
Dim target As String, reason As String
Set srcWs = ThisWorkbook.Sheets("Sheet1")
On Error Resume Next
Set logWs = ThisWorkbook.Sheets("ログ")
If logWs Is Nothing Then
Set logWs = ThisWorkbook.Sheets.Add(After:=srcWs)
logWs.Name = "ログ"
End If
On Error GoTo 0
' ログ初期化
logWs.Cells.ClearContents
logWs.Range("A1:D1").Value = Array("行番号", "対象セル", "条件一致", "理由")
lastRow = srcWs.Cells(srcWs.Rows.Count, "L").End(xlUp).Row
rowNum = 2
gCount = 0: nCount = 0
' 正式通関側チェック
For i = 6 To lastRow
pVal = srcWs.Cells(i, "P").Value
uVal = srcWs.Cells(i, "U").Value
vVal = srcWs.Cells(i, "V").Value
If pVal <> "" Then
If pVal = "*" Then
If uVal <> "" Then
target = "G103"
reason = "正式通関: P列*あり、U列入力あり"
gCount = gCount + 1
ElseIf vVal <> "" Then
target = "N103"
reason = "正式通関: P列*あり、U空白、V列入力あり"
nCount = nCount + 1
Else
target = "-"
reason = "正式通関: P列*あり、U/V空白"
End If
Else
target = "-"
reason = "正式通関: P列*なし"
End If
logWs.Cells(rowNum, 1).Value = i
logWs.Cells(rowNum, 2).Value = target
logWs.Cells(rowNum, 3).Value = IIf(target = "G103" Or target = "N103", "TRUE", "FALSE")
logWs.Cells(rowNum, 4).Value = reason
rowNum = rowNum + 1
End If
Next i
' G103・N103へ件数入力
srcWs.Range("G103").Value = gCount
srcWs.Range("N103").Value = nCount
MsgBox "正式通関のログ記録完了", vbInformation
End Sub
✅ ポイント
シート「ログ」自動作成
正式通関範囲（P・U・V列）自動チェック
簡易通関も同様に別サブルーチンで対応可能
もし正式・簡易両方まとめたログが必要なら追記します。
（通りすがり） 2025/07/15(火) 20:47:38
実行すると尋ねてくるので、それに答えるだけです。 解りました、出来ました。便利ですね。
それと冒頭の差額＄の記載は、
計算書・正式通関・簡易通関で
空白の次の行から、次のデータを手入力します。
例えば、正式通関で一件のデータを6行目に入れたとします。
次の7行目のＵ列にマクロで「値引き」の文字を表示（色も黄色をつけます）していただき
7行目の正式Ｖ列の項目、一部支払い/値引き欄に
次の値引き＄の計算をマクロでお願いします。（この値引き＄の計算が最後のデータとなります。）
値引き＄＝計算書のＤ列送金額＄－Ｘ列の合計－ＡＬ列の合計
少し見づらかったですね。すみませんでした。
通りすがり様
有難うございます。
ログのマクロを実行しましたら
sheetの隣のシートにシート名：ログ となってそこに下記のデータがはいりました。
行番号 対象セル 条件一致 理由
6 - FALSE 正式通関: P列*なし
8 - FALSE 正式通関: P列*なし
9 - FALSE 正式通関: P列*なし
65 - FALSE 正式通関: P列*なし
次に同じようにマクロを実行しましたら何の変化もございません。
正式通関（L列～X列）、簡易通関（Z列～AL列）どちらも確認
どのように確認をするのですか？
（愛子） 2025/07/15(火) 21:35:59
お尋ねしているのは、円貨のことはどこに書いてあるのですか、と言う点です。ドルの話じゃないです。 （xyz） 2025/07/15(火) 21:43:06
今、ふと円ではなく＄だったのではと思い確認をする為にここを開きました、すみませんでした、
再確認をします。
（愛子） 2025/07/15(火) 21:48:08
大変失礼しました。
値引き差額は、私の記載漏れでした。
誠に申し訳ございませんでした。
改めて、値引きと同じ行のＱ列に値引き＄に対する円を入れていただけませんか。
よろしくお願いします。
（愛子） 2025/07/15(火) 22:09:02
Dim ws As Worksheet, logWs As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
' ログシート確認・作成
On Error Resume Next
Set logWs = ThisWorkbook.Sheets("ログ")
If logWs Is Nothing Then
Set logWs = ThisWorkbook.Sheets.Add(After:=ws)
logWs.Name = "ログ"
Else
logWs.Cells.ClearContents
End If
On Error GoTo 0
logWs.Range("A1:E1").Value = Array("行番号", "対象セル", "区分", "条件一致", "理由")
Dim lastRow As Long, startRow As Long, endRow As Long, rowNum As Long
Dim i As Long, discountRow As Long, rowLog As Long
Dim gCount As Long, nCount As Long
Dim pVal, uVal, vVal, adVal, aiVal, ajVal, rateFormula As String
rowNum = 6
rowLog = 2
gCount = 0: nCount = 0
Do While ws.Cells(rowNum, "A").Value <> ""
startRow = rowNum
' 空白行までグループ判定
Do While ws.Cells(rowNum, "A").Value <> ""
rowNum = rowNum + 1
Loop
endRow = rowNum - 1
' rate用セル
rateFormula = "E" & startRow
' 正式通関 計算式入力
For i = startRow To endRow
ws.Cells(i, "X").Formula = "=P" & i & "+R" & i
ws.Cells(i, "Q").Formula = "=P" & i & "*" & rateFormula
ws.Cells(i, "S").Formula = "=R" & i & "*" & rateFormula
ws.Cells(i, "T").Formula = "=A" & startRow
ws.Cells(i, "U").Value = "三井住友/梅田"
ws.Cells(i, "W").Formula = "=" & rateFormula
Next i
ws.Cells(endRow, "Y").Formula = "=SUM(X" & startRow & ":X" & endRow & ")"
' 簡易通関 計算式入力
For i = startRow To endRow
ws.Cells(i, "AL").Formula = "=AD" & i & "+AF" & i
ws.Cells(i, "AE").Formula = "=AD" & i & "*" & rateFormula
ws.Cells(i, "AG").Formula = "=AF" & i & "*" & rateFormula
ws.Cells(i, "AH").Formula = "=A" & startRow
ws.Cells(i, "AI").Value = "三井住友/梅田"
ws.Cells(i, "AK").Formula = "=" & rateFormula
Next i
ws.Cells(endRow, "AM").Formula = "=SUM(AL" & startRow & ":AL" & endRow & ")"
' 差額、値引き
ws.Cells(startRow, "J").Formula = "=D" & startRow & "-Y" & endRow & "-AM" & endRow
discountRow = endRow + 1
ws.Cells(discountRow, "U").Value = "値引き"
ws.Cells(discountRow, "U").Interior.Color = RGB(255, 255, 0)
ws.Cells(discountRow, "V").Formula = "=D" & startRow & "-Y" & endRow & "-AM" & endRow
ws.Cells(discountRow, "Q").Formula = "=V" & discountRow & "*" & rateFormula
' ログ記録（正式通関）
For i = startRow To endRow
pVal = ws.Cells(i, "P").Value
uVal = ws.Cells(i, "U").Value
vVal = ws.Cells(i, "V").Value
If pVal = "*" Then
If uVal <> "" Then
logWs.Cells(rowLog, 1).Value = i
logWs.Cells(rowLog, 2).Value = "G103"
logWs.Cells(rowLog, 3).Value = "正式通関"
logWs.Cells(rowLog, 4).Value = "TRUE"
logWs.Cells(rowLog, 5).Value = "P*かつU入力"
rowLog = rowLog + 1
gCount = gCount + 1
ElseIf vVal <> "" Then
logWs.Cells(rowLog, 1).Value = i
logWs.Cells(rowLog, 2).Value = "N103"
logWs.Cells(rowLog, 3).Value = "正式通関"
logWs.Cells(rowLog, 4).Value = "TRUE"
logWs.Cells(rowLog, 5).Value = "P*かつV入力"
rowLog = rowLog + 1
nCount = nCount + 1
End If
End If
Next i
' 簡易通関ログ
For i = startRow To endRow
adVal = ws.Cells(i, "AD").Value
aiVal = ws.Cells(i, "AI").Value
ajVal = ws.Cells(i, "AJ").Value
If adVal = "*" Then
If aiVal <> "" Then
logWs.Cells(rowLog, 1).Value = i
logWs.Cells(rowLog, 2).Value = "G103"
logWs.Cells(rowLog, 3).Value = "簡易通関"
logWs.Cells(rowLog, 4).Value = "TRUE"
logWs.Cells(rowLog, 5).Value = "AD*かつAI入力"
rowLog = rowLog + 1
gCount = gCount + 1
ElseIf ajVal <> "" Then
logWs.Cells(rowLog, 1).Value = i
logWs.Cells(rowLog, 2).Value = "N103"
logWs.Cells(rowLog, 3).Value = "簡易通関"
logWs.Cells(rowLog, 4).Value = "TRUE"
logWs.Cells(rowLog, 5).Value = "AD*かつAJ入力"
rowLog = rowLog + 1
nCount = nCount + 1
End If
End If
Next i
' 次グループへ
rowNum = discountRow + 2
Loop
ws.Range("G103").Value = gCount
ws.Range("N103").Value = nCount
MsgBox "全グループ処理＆ログ記録完了", vbInformation
End Sub
（通りすがり） 2025/07/15(火) 22:16:50
Dim ws As Worksheet, logWs As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
' ログシート確認・作成
On Error Resume Next
Set logWs = ThisWorkbook.Sheets("ログ")
If logWs Is Nothing Then
Set logWs = ThisWorkbook.Sheets.Add(After:=ws)
logWs.Name = "ログ"
Else
logWs.Cells.ClearContents
End If
On Error GoTo 0
logWs.Range("A1:E1").Value = Array("行番号", "対象セル", "区分", "条件一致", "理由")
Dim lastRow As Long, rowNum As Long, rowLog As Long
Dim i As Long, pVal, uVal, vVal, adVal, aiVal, ajVal
Dim gCount As Long, nCount As Long, 区分 As String, target As String, reason As String
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
rowLog = 2
gCount = 0: nCount = 0
For i = 6 To lastRow
' 正式通関確認
pVal = ws.Cells(i, "P").Value
uVal = ws.Cells(i, "U").Value
vVal = ws.Cells(i, "V").Value
If pVal <> "" Then
区分 = "正式通関"
If pVal = "*" Then
If uVal <> "" Then
target = "G103": reason = "P列*かつU入力": gCount = gCount + 1
ElseIf vVal <> "" Then
target = "N103": reason = "P列*かつV入力": nCount = nCount + 1
Else
target = "-": reason = "P列*だがU・V空白"
End If
Else
target = "-": reason = "P列*無し"
End If
logWs.Cells(rowLog, 1).Value = i
logWs.Cells(rowLog, 2).Value = target
logWs.Cells(rowLog, 3).Value = 区分
logWs.Cells(rowLog, 4).Value = IIf(target="G103" Or target="N103", "TRUE", "FALSE")
logWs.Cells(rowLog, 5).Value = reason
rowLog = rowLog + 1
End If
' 簡易通関確認
adVal = ws.Cells(i, "AD").Value
aiVal = ws.Cells(i, "AI").Value
ajVal = ws.Cells(i, "AJ").Value
If adVal <> "" Then
区分 = "簡易通関"
If adVal = "*" Then
If aiVal <> "" Then
target = "G103": reason = "AD列*かつAI入力": gCount = gCount + 1
ElseIf ajVal <> "" Then
target = "N103": reason = "AD列*かつAJ入力": nCount = nCount + 1
Else
target = "-": reason = "AD列*だがAI・AJ空白"
End If
Else
target = "-": reason = "AD列*無し"
End If
logWs.Cells(rowLog, 1).Value = i
logWs.Cells(rowLog, 2).Value =
（通りすがり） 2025/07/15(火) 22:19:36
If adVal = "*" Then
If aiVal <> "" Then
target = "G103": reason = "AD列*かつAI入力": gCount = gCount + 1
ElseIf ajVal <> "" Then
target = "N103": reason = "AD列*かつAJ入力": nCount = nCount + 1
Else
target = "-": reason = "AD列*だがAI・AJ空白"
End If
Else
target = "-": reason = "AD列*無し"
End If
logWs.Cells(rowLog, 1).Value = i
logWs.Cells(rowLog, 2).Value = target
logWs.Cells(rowLog, 3).Value = 区分
logWs.Cells(rowLog, 4).Value = IIf(target="G103" Or target="N103", "TRUE", "FALSE")
logWs.Cells(rowLog, 5).Value = reason
rowLog = rowLog + 1
End If
Next i
ws.Range("G103").Value = gCount
ws.Range("N103").Value = nCount
MsgBox "最新ログ記録完了", vbInformation
End Sub
切れてしまったのでキリの良いとこから貼り付けします
✅ ログ記録マクロ（正式通関・簡易通関両方の条件判定）
→ 下のコード：「ログ記録最新版」
👉 判定結果を「ログ」シートに記録、G103・N103に件数記載
両方セットで運用すれば、
本体マクロでデータ整形と計算、
ログ記録マクロで確認記録・エビデンス作成
ができます。
✅ 必要なら、ボタン連動・一括実行化も対応可能です。
※上記、動作確認できたら作成しますね。
動作確認してからじゃないと頭が混乱するので…
（通りすがり） 2025/07/15(火) 22:32:01
通りすがり様
上を実行しましたら
コンパイルエラーとでました。
logWs.Cells(rowLog, 2).Value =
end sub も有りませんね。
再度上のマクロで実行します。
動作を確認してから・・・はい、わかりました。
（愛子） 2025/07/15(火) 22:46:11
実行しましたら コンパイルエラーです。
logWs.Cells(rowLog, 2).Value =
（愛子） 2025/07/15(火) 22:54:44
よく見ると私のコードを貼り付けるのが誤っていました。
すみませんでした。正しました。
通りすがり） 2025/07/15(火) 22:32:01
のコードをsubのないコードに追加でそのまま貼っていました。
実行しましたら下記のようになりました。
行番号 対象セル 区分 条件一致 理由
6 - 正式通関 FALSE P列*無し
6 - 簡易通関 FALSE AD列*無し
8 - 正式通関 FALSE P列*無し
8 - 簡易通関 FALSE AD列*無し
「最新ログ記録完了」
ここで再度そのコードを実行しましたら変化はないのですが、
もう一つやり方が理解できていません。
続きは、どのようにすればいいのでしょうか？教えていただけますか？
（愛子） 2025/07/16(水) 06:03:35
なので 「対象セル」が「-」で「FALSE」 と出ています。
これは「*」が入力されていないため、正常動作です。
✅ こうすれば変化します
もしログに TRUE 判定を表示したい場合は：
正式通関（P列）または簡易通関（AD列）のデータに * を入れてみてください。
例：P6セルに * を入力してU6またはV6に何か値を入力
例：AD6セルに * を入力してAI6またはAJ6に何か値を入力
✅ そうすると再実行で「TRUE」に変わり対象セルが G103 や N103 に変わります。
✅ 続きの流れ（おすすめ）
データ入力を確認・追加する（例：P列、U列、V列に値を入れる）
「本体マクロ」を先に実行
差額や円換算などの式を入力
「ログ記録マクロ」を実行
ログシートでデータの整合性確認
必要ならG103、N103件数を確認
💡 理解のポイント
ログマクロは「*」マークがある行の特定条件（U列/V列/AI列/AJ列入力）を確認
データ変更後に再実行しないと、ログ内容は更新されません
（通りすがり） 2025/07/16(水) 06:41:25
今から仕事に行きます。
後で試します。
（愛子） 2025/07/16(水) 08:07:25
言われますように、マクロを実行後に＊印を入れて値を言われる列行に入力してから
ログ記録マクロを実行しました。下記のように変化が見られ理由も合っています。
行番号 対象セル 区分 条件一致 理由
6 G103 簡易通関 TRUE AD*かつAI入力
未だ続けないといけないのでしょうか？
一回目は差額の、＄￥もその他の計算式と計算書より同じデータの自動転記等うまくいっていますので、
あとは複数のデータだけをマクロで作成していただくだけと思いますが。
ｘｙｚさんの質問ではないですが、具体的にお伝えするとしまして、
２回目のデータは、正式通関と簡易通関のどちらか多いデータの最後の行（値引き行）から一行空けた
次の行から手入力していきます。（例えば１回目の簡易通関の最後（値引き行）のデータが７行目とします。
次のデータは、計算書と正式通関と簡易通関の行は、９行目からデータを手入力します。
詰めてデータを手入力後、次の行が余白迄一つのグループとして計算書から同じデータをマクロ転記を
していただき、各￥金額計算、値引き計算、三井住友銀行の文字、小計の計算等をマクロで
自動処理をして頂こうと思っています。
３回目以降も同じ要領です。
何卒よろしくお願いいたします。
（愛子） 2025/07/16(水) 13:41:18
Dim ws As Worksheet, logWs As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
' ログシート確認・作成
On Error Resume Next
Set logWs = ThisWorkbook.Sheets("ログ")
If logWs Is Nothing Then
Set logWs = ThisWorkbook.Sheets.Add(After:=ws)
logWs.Name = "ログ"
Else
logWs.Cells.ClearContents
End If
On Error GoTo 0
logWs.Range("A1:E1").Value = Array("行番号", "対象セル", "区分", "条件一致", "理由")
Dim rowNum As Long, startRow As Long, endRow As Long, rowLog As Long
Dim i As Long, discountRow As Long
Dim gCount As Long, nCount As Long
Dim pVal, uVal, vVal, adVal, aiVal, ajVal, rateFormula As String
rowNum = 6
rowLog = 2
gCount = 0: nCount = 0
Do While ws.Cells(rowNum, "A").Value <> ""
startRow = rowNum
Do While ws.Cells(rowNum, "A").Value <> ""
rowNum = rowNum + 1
Loop
endRow = rowNum - 1
rateFormula = "E" & startRow
' 正式通関 計算式
For i = startRow To endRow
ws.Cells(i, "X").Formula = "=P" & i & "+R" & i
ws.Cells(i, "Q").Formula = "=P" & i & "*" & rateFormula
ws.Cells(i, "S").Formula = "=R" & i & "*" & rateFormula
ws.Cells(i, "T").Formula = "=A" & startRow
ws.Cells(i, "U").Value = "三井住友/梅田"
ws.Cells(i, "W").Formula = "=" & rateFormula
Next i
ws.Cells(endRow, "Y").Formula = "=SUM(X" & startRow & ":X" & endRow & ")"
' 簡易通関 計算式
For i = startRow To endRow
ws.Cells(i, "AL").Formula = "=AD" & i & "+AF" & i
ws.Cells(i, "AE").Formula = "=AD" & i & "*" & rateFormula
ws.Cells(i, "AG").Formula = "=AF" & i & "*" & rateFormula
ws.Cells(i, "AH").Formula = "=A" & startRow
ws.Cells(i, "AI").Value = "三井住友/梅田"
ws.Cells(i, "AK").Formula = "=" & rateFormula
Next i
ws.Cells(endRow, "AM").Formula = "=SUM(AL" & startRow & ":AL" & endRow & ")"
' 計算書差額・値引き
ws.Cells(startRow, "J").Formula = "=D" & startRow & "-Y" & endRow & "-AM" & endRow
discountRow = endRow + 1
ws.Cells(discountRow, "U").Value = "値引き"
ws.Cells(discountRow, "U").Interior.Color = RGB(255, 255, 0)
ws.Cells(discountRow, "V").Formula = "=D" & startRow & "-Y" & endRow & "-AM" & endRow
ws.Cells(discountRow, "Q").Formula = "=V" & discountRow & "*" & rateFormula
' ログ記録
For i = startRow To endRow
pVal = ws.Cells(i, "P").Value
uVal = ws.Cells(i, "U").Value
vVal = ws.Cells(i, "V").Value
If pVal = "*" Then
If uVal <> "" Then
logWs.Cells(rowLog, 1).Value = i
logWs.Cells(rowLog, 2).Value = "G103"
logWs.Cells(rowLog, 3).Value = "正式通関"
logWs.Cells(rowLog, 4).Value = "TRUE"
logWs.Cells(rowLog, 5).Value = "P*かつU入力"
gCount = gCount + 1
rowLog = rowLog + 1
ElseIf vVal <> "" Then
logWs.Cells(rowLog, 1).Value = i
logWs.Cells(rowLog, 2).Value = "N103"
logWs.Cells(rowLog, 3).Value = "正式通関"
logWs.Cells(rowLog, 4).Value = "TRUE"
logWs.Cells(rowLog, 5).Value = "P*かつV入力"
nCount = nCount + 1
rowLog = rowLog + 1
End If
End If
adVal = ws.Cells(i, "AD").Value
aiVal = ws.Cells(i, "AI").Value
ajVal = ws.Cells(i, "AJ").Value
If adVal = "*" Then
If aiVal <> "" Then
logWs.Cells(rowLog, 1).Value = i
logWs.Cells(rowLog, 2).Value = "G103"
logWs.Cells(rowLog, 3).Value = "簡易通関"
logWs.Cells(rowLog, 4).Value = "TRUE"
logWs.Cells(rowLog, 5).Value = "AD*かつAI入力"
gCount = gCount + 1
rowLog = rowLog + 1
ElseIf ajVal <> "" Then
logWs.Cells(rowLog, 1).Value = i
logWs.Cells(rowLog, 2).Value = "N103"
logWs.Cells(rowLog, 3).Value = "簡易通関"
logWs.Cells(rowLog, 4).Value = "TRUE"
logWs.Cells(rowLog, 5).Value = "AD*かつAJ入力"
nCount = nCount + 1
rowLog = rowLog + 1
End If
End If
Next i
rowNum = discountRow + 2
Loop
ws.Range("G103").Value = gCount
ws.Range("N103").Value = nCount
MsgBox "複数グループ処理とログ記録が完了しました", vbInformation
End Sub
✅ 複数データ対応の最新フルコードを更新しました。
これで複数グループでも、まとめて自動計算＆ログ記録できます。
これで、上手くいくか確認お願いします
（通りすがり） 2025/07/16(水) 14:52:12
マクロを実行しました。
手入力のデータは、計算書、正式通関、簡易通関は、８行目に空白、９行目から入力しています。
正式通関のデータは、９行と１０行目です。
簡易通関のデータは、９行から１８行目までです。
正式通関では、９行目はすべて上手くいっています。輸入金額￥と運賃￥、送金日からrate迄自動転記、
小計もOKです。しかし１０行目は輸入金額￥と運賃￥と送金日から小計までブランクです。
本来値引き表示と＄差額は、１１行目にくるはずですが、１０行目になっています。
Ｖ１０の＄差額の式は、ｄ９-ｙ９-ＡＭ９です。
ｑ１０の輸入￥の処の式は、差額＄かけるＥ９（rate）となっています。
簡易通関では、９行目は全て上手くいっていますが、
１０行目から１８行目まで全てブランクです。
このような状況でした。
よろしくお願いします。
（愛子） 2025/07/16(水) 19:49:31
✅ 正式通関の9行目だけ正常、10行目の数式が空白
✅ 簡易通関も9行目のみOK、10～18行目が空白
✅ 「値引き表示」と差額が1件目の直後（10行目）にきてしまう
✅ 原因のポイント
現在のコードは「A列空白行で区切る方式」のため、計算書の空白＝正式通関・簡易通関も空白と見なしてグループを誤認識している
でも現実には「正式通関と簡易通関」は空白行なく続く場合がある
✅ 解決方針
✔️ 「空白行区切り」は計算書（A列）のみでグループ判定するのはOK
✔️ でも「グループ内の正式通関（L～X）」「簡易通関（Z～AL）」は各自の最終行を判定し、そこまで数式適用・小計・値引き処理を行う
✅ 改善内容の例：
A列：グループ開始位置を判定
L列：正式通関の最終行（P列空白）まで探して適用
Z列：簡易通関の最終行（AD列空白）まで探して適用
値引き行は正式通関・簡易通関の最終行の次行で処理
📝 次の質問：
この方針（グループごとに正式・簡易の終端まで判定）で良ければ、修正版コード準備します。
もし「空白行無し」の特例もあれば教えてください。
宜しくお願いします🙏
（通りすがり） 2025/07/16(水) 20:27:33
早速に有難うございます。そして上手にまとめていただき有難うございます。
すべてその通りです。そして空白行は、１つの区切りで必要です。
計算書の一行のデータを基準に同じ行の正式通関と簡易通関を条件に
正式通関と簡易通関のどちらかのデータが多い時に（空白までの行をグループとします。）
多いデータの最後の行の次の行に合わせて正式通関の値引き表示と＄差額を表示していただきます。
１つ教えていただきたいのが、L列：正式通関の最終行（P列空白）まで探して適用のＰ列空白とは？
Ｐ列は輸入金額＄で空白ではありませんので。
Z列：簡易通関の最終行（AD列空白）まで探して適用のＡＤ列も輸入金額＄で金額が入っています。
よろしくお願いします。
（愛子） 2025/07/16(水) 21:12:04
お返事がないものですから、私は間違った言い方をしとかと思い
読み直しますと早合点したところに気づきました。
それは、
＞１つ教えていただきたいのが、L列：正式通関の最終行（P列空白）まで探して適用のＰ列空白とは？
Ｐ列は輸入金額＄で空白ではありませんので。
＞Z列：簡易通関の最終行（AD列空白）まで探して適用のＡＤ列も輸入金額＄で金額が入っています。
輸入金額＄の数字が入っている行を言っているのではないのに（データが入っているＰ列の空白行を
さがして処理をしようと思われているのに）勝手に早合点をして申し訳ございませんでした。
改めてこの方針（グループごとに正式・簡易の終端まで判定）で充分ですので、修正版コードをよろしく
おねがいします。
（愛子） 2025/07/17(木) 05:27:20
Dim ws As Worksheet, logWs As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
On Error Resume Next
Set logWs = ThisWorkbook.Sheets("ログ")
If logWs Is Nothing Then
Set logWs = ThisWorkbook.Sheets.Add(After:=ws)
logWs.Name = "ログ"
Else
logWs.Cells.ClearContents
End If
On Error GoTo 0
logWs.Range("A1:E1").Value = Array("行番号", "対象セル", "区分", "条件一致", "理由")
Dim lastRow As Long, currentRow As Long, logRow As Long
Dim groupStart As Long, groupEnd As Long
Dim formalStart As Long, formalEnd As Long
Dim simpleStart As Long, simpleEnd As Long
Dim maxEndRow As Long, discountRow As Long
Dim i As Long, gCount As Long, nCount As Long
Dim pVal, uVal, vVal, adVal, aiVal, ajVal, rateCell As String
currentRow = 6
logRow = 2
gCount = 0: nCount = 0
Do While ws.Cells(currentRow, "A").Value <> ""
groupStart = currentRow
Do While ws.Cells(currentRow, "A").Value <> ""
currentRow = currentRow + 1
Loop
groupEnd = currentRow - 1
formalStart = groupStart
i = groupStart
Do While ws.Cells(i, "L").Value <> ""
i = i + 1
Loop
formalEnd = i - 1
simpleStart = groupStart
i = groupStart
Do While ws.Cells(i, "Z").Value <> ""
i = i + 1
Loop
simpleEnd = i - 1
If formalEnd > simpleEnd Then
maxEndRow = formalEnd
Else
maxEndRow = simpleEnd
End If
discountRow = maxEndRow + 1
rateCell = "E" & groupStart
' 正式通関 計算式
For i = formalStart To formalEnd
ws.Cells(i, "X").Formula = "=P" & i & "+R" & i
ws.Cells(i, "Q").Formula = "=P" & i & "*" & rateCell
ws.Cells(i, "S").Formula = "=R" & i & "*" & rateCell
ws.Cells(i, "T").Formula = "=A" & groupStart
ws.Cells(i, "U").Value = "三井住友/梅田"
ws.Cells(i, "W").Formula = "=" & rateCell
Next i
ws.Cells(formalEnd, "Y").Formula = "=SUM(X" & formalStart & ":X" & formalEnd & ")"
' 簡易通関 計算式
For i = simpleStart To simpleEnd
ws.Cells(i, "AL").Formula = "=AD" & i & "+AF" & i
ws.Cells(i, "AE").Formula = "=AD" & i & "*" & rateCell
ws.Cells(i, "AG").Formula = "=AF" & i & "*" & rateCell
ws.Cells(i, "AH").Formula = "=A" & groupStart
ws.Cells(i, "AI").Value = "三井住友/梅田"
ws.Cells(i, "AK").Formula = "=" & rateCell
Next i
ws.Cells(simpleEnd, "AM").Formula = "=SUM(AL" & simpleStart & ":AL" & simpleEnd & ")"
' 差額・値引き
ws.Cells(groupStart, "J").Formula = "=D" & groupStart & "-Y" & formalEnd & "-AM" & simpleEnd
ws.Cells(discountRow, "U").Value = "値引き"
ws.Cells(discountRow, "U").Interior.Color = RGB(255, 255, 0)
ws.Cells(discountRow, "V").Formula = "=D" & groupStart & "-Y" & formalEnd & "-AM" & simpleEnd
ws.Cells(discountRow, "Q").Formula = "=V" & discountRow & "*" & rateCell
' ログ記録
For i = formalStart To formalEnd
pVal = ws.Cells(i, "P").Value
uVal = ws.Cells(i, "U").Value
vVal = ws.Cells(i, "V").Value
logWs.Cells(logRow, 1).Value = i
logWs.Cells(logRow, 2).Value = "正式通関"
If pVal = "*" Then
If uVal <> "" Then
logWs.Cells(logRow, 3).Value = "G103"
logWs.Cells(logRow, 4).Value = "TRUE"
logWs.Cells(logRow, 5).Value = "P*かつU入力"
gCount = gCount + 1
ElseIf vVal <> "" Then
logWs.Cells(logRow, 3).Value = "N103"
logWs.Cells(logRow, 4).Value = "TRUE"
logWs.Cells(logRow, 5).Value = "P*かつV入力"
nCount = nCount + 1
Else
logWs.Cells(logRow, 3).Value = "-"
logWs.Cells(logRow, 4).Value = "FALSE"
logWs.Cells(logRow, 5).Value = "P*だがU・V空欄"
End If
Else
logWs.Cells(logRow, 3).Value = "-"
logWs.Cells(logRow, 4).Value = "FALSE"
logWs.Cells(logRow, 5).Value = "P列*なし"
End If
logRow = logRow + 1
Next i
For i = simpleStart To simpleEnd
adVal = ws.Cells(i, "AD").Value
aiVal = ws.Cells(i, "AI").Value
ajVal = ws.Cells(i, "AJ").Value
logWs.Cells(logRow, 1).Value = i
logWs.Cells(logRow, 2).Value = "簡易通関"
If adVal = "*" Then
If aiVal <> "" Then
logWs.Cells(logRow, 3).Value = "G103"
logWs.Cells(logRow, 4).Value = "TRUE"
logWs.Cells(logRow, 5).Value = "AD*かつAI入力"
gCount = gCount + 1
ElseIf ajVal <> "" Then
logWs.Cells(logRow, 3).Value = "N103"
logWs.Cells(logRow, 4).Value = "TRUE"
logWs.Cells(logRow, 5).Value = "AD*かつAJ入力"
nCount = nCount + 1
Else
logWs.Cells(logRow, 3).Value = "-"
logWs.Cells(logRow, 4).Value = "FALSE"
logWs.Cells(logRow, 5).Value = "AD*だがAI・AJ空欄"
End If
Else
logWs.Cells(logRow, 3).Value = "-"
logWs.Cells(logRow, 4).Value = "FALSE"
logWs.Cells(logRow, 5).Value = "AD列*なし"
End If
logRow = logRow + 1
Next i
currentRow = discountRow + 2
Loop
ws.Range("G103").Value = gCount
ws.Range("N103").Value = nCount
MsgBox "複数グループ処理＆ログ作成完了！", vbInformation
End Sub
✅ 複数グループ対応の最新フルコードを作成しました。
シート「Sheet1」で複数データ、値引き表示・差額計算・数式自動入力・ログ記録まで一括対応します。
✅ 理由のまとめ：
正式通関 → L列が空白になるまで（P列の値有無ではなく「行自体が空白」で判定）
簡易通関 → Z列が空白になるまで（AD列ではなくZ列空白）
A列（計算書）はグループ基準
一番行数の多い方の次行に「値引き行」を追加
すべてのグループごとに適切な処理＋ログ記録を実行
✅ ✅ 「P列空白」「AD列空白」誤解は既に排除済みです。
また、何かありましたらお知らせください
（通りすがり） 2025/07/17(木) 05:39:53
2025/07/15(火) 09:12:51 で書いた検証用の元データの提供はいただけないようで残念です。 ツールのご案内もしましたが。
また、正式通関と計算書だけ、簡易通関と計算書だけのケースの有無の回答もありませんでした。 もしそういうケースがあれば、生成AI作成と思われるコードにも一部変更が必要になると思います。
開始行の話についてもです。
以下の修正コード（差額の円貨換算値の反映の提示漏れに伴うもの）を提示して、私はここまでとします。
Option Explicit Dim ws As Worksheet
Sub main()
Dim k As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
For k = 6 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
If ws.Cells(k, "A") > 0 Then
Call oneGroup処理(k)
End If
Next
MsgBox "全グループ数式処理が完了しました！", vbInformation
End Sub
Sub oneGroup処理(k As Long)
Dim startRow&
Dim r&
Dim endRow1&, endRow2&
Dim flag1 As Boolean, flag2 As Boolean
Dim discountRow&
startRow = k
' 正式通関
r = startRow
Do While Cells(r, "P") > 0
flag1 = True
ws.Cells(r, "X").Formula = "=P" & r & "+R" & r
ws.Cells(r, "Q").Formula = "=P" & r & "*$E" & startRow
ws.Cells(r, "S").Formula = "=R" & r & "*$E" & startRow
ws.Cells(r, "T").Formula = "=A" & startRow
ws.Cells(r, "U").Value = "三井住友/梅田"
ws.Cells(r, "W").Formula = "=E" & startRow
endRow1 = r
r = r + 1
Loop
' 簡易通関
r = startRow
Do While Cells(r, "AD") > 0
flag2 = True
ws.Cells(r, "AL").Formula = "=AD" & r & "+AF" & r
ws.Cells(r, "AE").Formula = "=AD" & r & "*$E" & startRow
ws.Cells(r, "AG").Formula = "=AF" & r & "*$E" & startRow
ws.Cells(r, "AH").Formula = "=A" & startRow
ws.Cells(r, "AI").Value = "三井住友/梅田"
ws.Cells(r, "AK").Formula = "=E" & startRow
endRow2 = r
r = r + 1
Loop
' 小計合計
If flag1 Then ws.Cells(endRow1, "Y").Formula = "=SUM(X" & startRow & ":X" & endRow1 & ")"
If flag2 Then ws.Cells(endRow2, "AM").Formula = "=SUM(AL" & startRow & ":AL" & endRow2 & ")"
' 計算書：差額
ws.Cells(startRow, "J").Formula = "=D" & startRow _
& IIf(flag1, "-Y" & endRow1, "") _
& IIf(flag2, "-AM" & endRow2, "")
' 値引き行追加
discountRow = Application.Max(endRow1, endRow2) + 1
ws.Cells(discountRow, "U").Value = "値引き"
ws.Cells(discountRow, "U").Interior.Color = RGB(255, 255, 0)
ws.Cells(discountRow, "V").Formula = "=D" & startRow _
& IIf(flag1, "-Y" & endRow1, "") _
& IIf(flag2, "-AM" & endRow2, "")
ws.Cells(discountRow, "Q").Formula = "=V" & discountRow & "*$E" & startRow '■■値引き(円貨)追加■■
'■■デバッグ用に、1グループの最終行に罫線を引く （用済みになったら消して下さい）■■
With ws.Cells(discountRow + 1, "A").Resize(1, 39).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End Sub
（xyz） 2025/07/17(木) 08:11:12
xyz様
色々有難うございます。
通りすがり様から順次ご回答を得ているからといって、
ｘｙｚ様のことをいい加減に聞いていません。
しっかり見させていただき返答をしているつもりです。
一生懸命にご協力くださっていますのに、誤解を招き申し訳ございませんでした。
変更後のマクロ有難うございました。後で実行します。
＞私は、ここまでとしますは、それこそ残念です。
＞2025/07/15(火) 09:12:51 で書いた検証用の元データの提供はいただけないようで残念です。
ツールのご案内もしましたが、開始行の話についてもです。 ＞また、正式通関と計算書だけ、簡易通関と計算書だけのケースの有無の回答もありませんでした。
その質問は覚えていないのです。すみません。
回答は、計算書を基に正式通関と簡易通関は。両方あります。
検証用の元データの提供につきましてのお返事は、
7/15㈫10:18:21に私が記載しました下記の記載で、
＞２回目で複数のデータのマクロを実行してから違いがあれば依頼するつもりでいました。
私の意向を示したつもりでした。すみませんでした
下記が、7/15㈫10:18:21に私の記載です。
ｘｙｚ様、今拝見しました。
お宅様の言われること全てその通りだとおもいます。
複数なら複数件、実際に表にあらわしてから、ここはこのようにして頂きたいと
お伝えするのが本筋だと思います。
言い訳になりますが、冒頭に私の提案を記載しました。
沢山まとまりのない提示を通りすがり様は、理解していただき、私の思うように
全て一件のデータのみとして細部にわたり作成されましたので
それ以上深く考えていませんでした。
２回目で複数のデータのマクロを実行してから違いがあれば依頼するつもりでいました。
（愛子） 2025/07/17(木) 11:20:05
別に批判のための批判をする積りはありませんが、今後もこちらで質問されるのであればと思い、 敢えてコメントしておきます。
(1) > その質問は覚えていないのです。すみません。 私の発言はきちんと残っています > 少なくともどんなパターンがありうるのかくらいは説明すべきかなと思います。 > 例えば、簡易通関（と計算書）だけがあるケースもあるんですか？こうしたことは部外者にはわかりません。 > その場合でも、値引き額は、正式通関のエリアに書くのですか？ > また、正式通関が1件、簡易通関が2件あったとき、値引き額はどの行に書くのですか？ > それらもわかるように示してください。 回答する積りがあれば、確認質問を見ながらキチンと回答するはずです。 失礼な対応とは思うものの、今回のご返事から、まあその程度の受け止めをされるこちらの対応だったということを理解しました。 不徳の致すところです。
(2) >お宅様の言われること全てその通りだとおもいます。 ・・・・ >２回目で複数のデータのマクロを実行してから違いがあれば依頼するつもりでいました。 その積りでいたが、指摘を受けてその通りだと思いました、との発言とこちらが曲解していたわけですか。 最初からデータを示す積りなどなく、"その通り"というのは、単なる社交辞令だったということですか。これも不徳・・。
(3) サンプルの重要性はこの質問掲示板でも何度となく経験しています。 お互いの誤解を防ぐ重要な方法です。 差額の円貨についてがよい例です。
標準的なケースでオーライと思っても、色々なケースがありうるのでそこは慎重に検討することが求められます。 そのときポイントになるのは事情を知っている側がきちんとした情報を上げることなんです。 コードを作らせてから、と言うのではないのです。
対応事項が漏れていないかもお互いに確認する必要はあります。 （例えば、I列の合計欄はブランクのままでよいのかとかといった話です。）
回り道のようですが、サンプルと想定結果の提示はこうした質問掲示板では大事な要素であることを 再度強調しておきます。 今後の質問に活かしていただきたいと思います。
通りすがりさんも質問者さんもお疲れさまでした。 （xyz） 2025/07/17(木) 15:37:10
一つ追加がございます。計算書の送金先を正式通関と簡易通関の商品仕入先Ｍ列とＡＡ列に
転記していただきたいのです。
それは、今までは、わからなかったので、計算書の送金先と正式通関と簡易通関の商品仕入先が違うと思っていまして、今までは、手入力をしていました。（送金日は同じ日でも２回に分けて送金する際には、正式通関と簡易通関の商品仕入れ先が違っていましたので。）
しかし前月の履歴をみた後にそのことを前担当者にお聞きすると一回一回の計算書と一回一回の正式通関と簡易通関の商品仕入れ先の名前が同じということを確認いたしました。
追加申請になりご負担をおかけしますが、よろしくお願いいたします。
それと当該に関して色々確認をしていきましたが、今回の追加でおさまると思っています。
今期の決算が
ｘｙｚ様
マクロを実行しました。値引き差額の￥と共に、私の提案が全てかなっていました。
今までのご尽力、本当に有難うございました。
・・・・・・・・・・
私のこのコメントをアップしたつもりでしたが未だでした。
会社の帰り掛でシャットダウンするときにきずきました。
ｘｙｚ様のコメント、自宅に帰ってからお読みしてお返事をします。すみませんでした。
（愛子） 2025/07/17(木) 16:14:00
Dim ws As Worksheet, logWs As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
On Error Resume Next
Set logWs = ThisWorkbook.Sheets("ログ")
If logWs Is Nothing Then
Set logWs = ThisWorkbook.Sheets.Add(After:=ws)
logWs.Name = "ログ"
Else
logWs.Cells.ClearContents
End If
On Error GoTo 0
logWs.Range("A1:E1").Value = Array("行番号", "対象セル", "区分", "条件一致", "理由")
Dim lastRow As Long, currentRow As Long, logRow As Long
Dim groupStart As Long, groupEnd As Long
Dim formalStart As Long, formalEnd As Long
Dim simpleStart As Long, simpleEnd As Long
Dim maxEndRow As Long, discountRow As Long
Dim i As Long, gCount As Long, nCount As Long
Dim pVal, uVal, vVal, adVal, aiVal, ajVal, rateCell As String
currentRow = 6
logRow = 2
gCount = 0: nCount = 0
Do While ws.Cells(currentRow, "A").Value <> ""
groupStart = currentRow
Do While ws.Cells(currentRow, "A").Value <> ""
currentRow = currentRow + 1
Loop
groupEnd = currentRow - 1
formalStart = groupStart
i = groupStart
Do While ws.Cells(i, "L").Value <> ""
i = i + 1
Loop
formalEnd = i - 1
simpleStart = groupStart
i = groupStart
Do While ws.Cells(i, "Z").Value <> ""
i = i + 1
Loop
simpleEnd = i - 1
If formalEnd > simpleEnd Then
maxEndRow = formalEnd
Else
maxEndRow = simpleEnd
End If
discountRow = maxEndRow + 1
rateCell = "E" & groupStart
' 正式通関 計算式 + 送金先転記
For i = formalStart To formalEnd
ws.Cells(i, "M").Value = ws.Cells(groupStart, "C").Value '送金先→商品仕入先
ws.Cells(i, "X").Formula = "=P" & i & "+R" & i
ws.Cells(i, "Q").Formula = "=P" & i & "*" & rateCell
ws.Cells(i, "S").Formula = "=R" & i & "*" & rateCell
ws.Cells(i, "T").Formula = "=A" & groupStart
ws.Cells(i, "U").Value = "三井住友/梅田"
ws.Cells(i, "W").Formula = "=" & rateCell
Next i
ws.Cells(formalEnd, "Y").Formula = "=SUM(X" & formalStart & ":X" & formalEnd & ")"
' 簡易通関 計算式 + 送金先転記
For i = simpleStart To simpleEnd
ws.Cells(i, "AA").Value = ws.Cells(groupStart, "C").Value '送金先→商品仕入先
ws.Cells(i, "AL").Formula = "=AD" & i & "+AF" & i
ws.Cells(i, "AE").Formula = "=AD" & i & "*" & rateCell
ws.Cells(i, "AG").Formula = "=AF" & i & "*" & rateCell
ws.Cells(i, "AH").Formula = "=A" & groupStart
ws.Cells(i, "AI").Value = "三井住友/梅田"
ws.Cells(i, "AK").Formula = "=" & rateCell
Next i
ws.Cells(simpleEnd, "AM").Formula = "=SUM(AL" & simpleStart & ":AL" & simpleEnd & ")"
' 差額・値引き
ws.Cells(groupStart, "J").Formula = "=D" & groupStart & "-Y" & formalEnd & "-AM" & simpleEnd
ws.Cells(discountRow, "U").Value = "値引き"
ws.Cells(discountRow, "U").Interior.Color = RGB(255, 255, 0)
ws.Cells(discountRow, "V").Formula = "=D" & groupStart & "-Y" & formalEnd & "-AM" & simpleEnd
ws.Cells(discountRow, "Q").Formula = "=V" & discountRow & "*" & rateCell
' ログ記録
For i = formalStart To formalEnd
pVal = ws.Cells(i, "P").Value
uVal = ws.Cells(i, "U").Value
vVal = ws.Cells(i, "V").Value
If pVal = "*" Then
If uVal <> "" Then
logWs.Cells(logRow, 1).Value = i
logWs.Cells(logRow, 2).Value = "G103"
logWs.Cells(logRow, 3).Value = "正式通関"
logWs.Cells(logRow, 4).Value = "TRUE"
logWs.Cells(logRow, 5).Value = "P*かつU入力"
gCount = gCount + 1
logRow = logRow + 1
ElseIf vVal <> "" Then
logWs.Cells(logRow, 1).Value = i
logWs.Cells(logRow, 2).Value = "N103"
logWs.Cells(logRow, 3).Value = "正式通関"
logWs.Cells(logRow, 4).Value = "TRUE"
logWs.Cells(logRow, 5).Value = "P*かつV入力"
nCount = nCount + 1
logRow = logRow + 1
End If
End If
Next i
For i = simpleStart To simpleEnd
adVal = ws.Cells(i, "AD").Value
aiVal = ws.Cells(i, "AI").Value
ajVal = ws.Cells(i, "AJ").Value
If adVal = "*" Then
If aiVal <> "" Then
logWs.Cells(logRow, 1).Value = i
logWs.Cells(logRow, 2).Value = "G103"
logWs.Cells(logRow, 3).Value = "簡易通関"
logWs.Cells(logRow, 4).Value = "TRUE"
logWs.Cells(logRow, 5).Value = "AD*かつAI入力"
gCount = gCount + 1
logRow = logRow + 1
ElseIf ajVal <> "" Then
logWs.Cells(logRow, 1).Value = i
logWs.Cells(logRow, 2).Value = "N103"
logWs.Cells(logRow, 3).Value = "簡易通関"
logWs.Cells(logRow, 4).Value = "TRUE"
logWs.Cells(logRow, 5).Value = "AD*かつAJ入力"
nCount = nCount + 1
logRow = logRow + 1
End If
End If
Next i
currentRow = discountRow + 2
Loop
ws.Range("G103").Value = gCount
ws.Range("N103").Value = nCount
MsgBox "複数グループ処理完了！", vbInformation
End Sub
確認お願いします
（通りすがり） 2025/07/17(木) 16:27:58
＞ところで、正式通関を利用した2件、簡易通関を利用した1件、
これら3件合計の計算書が1行などということは無いのですか？ 正式通関と計算書だけ、簡易通関と計算書だけのケースの有無の回答もありませんでした。
＞ 別に批判のための批判をする積りはありませんが、今後もこちらで質問されるのであればと思い、
敢えてコメントしておきます。
その通りですね。今後気をつけます。教えていただき有難うございます。
＞
回答する積りがあれば、確認質問を見ながらキチンと回答するはずです。 失礼な対応とは思うものの、今回のご返事から、まあその程度の受け止めをされるこちらの対応だったということを理解しました。
言い訳をしたくないのですが、この文字を見るときに目が悪くて文字が２重にばやっと見えたり目が自然につぶるようになっていくのです。
私は、覚えていないと思いｘｙｚ様の質問を探そうと思ったのですよ。
でも探すことが辛かったのです。だから私はわすれているだけで、ｘｙｚ様の言っている事をないがしろに
したりしていませんよ。 当然信じていますよ。遡って見るのがつらかっただけです。
ただｘｙｚ様の文字は、更に小さいです。私にとっては余計にみにくいのです。
改めて提案をお伝えする時には、良い意味でご注意を受けたことは、忘れないように
マクロを実行する前に、マクロを作成される方に意向を確認しながら進んでいきます。
今後ともよろしくお願いします。
不徳の致すところです。
(2) >お宅様の言われること全てその通りだとおもいます。 ・・・・ >２回目で複数のデータのマクロを実行してから違いがあれば依頼するつもりでいました。 その積りでいたが、指摘を受けてその通りだと思いました、との発言とこちらが曲解していたわけですか。 最初からデータを示す積りなどなく、"その通り"というのは、単なる社交辞令だったということですか。これも不徳・・。 （愛子） 2025/07/17(木) 19:14:05
ｘyz様、 ７月１７日１９：１４：０５での最後の文章で今後ともよろしくお願いします。の次の文章は 余分な文章が残っていまして気づかずに失礼しました。
不徳の致すところです。
(2) >お宅様の言われること全てその通りだとおもいます。 ・・・・ >２回目で複数のデータのマクロを実行してから違いがあれば依頼するつもりでいました。 その積りでいたが、指摘を受けてその通りだと思いました、との発言とこちらが曲解していたわけですか。 最初からデータを示す積りなどなく、"その通り"というのは、単なる社交辞令だったということですか。これも不徳・・。 （愛子） 2025/07/17(木) 21:24:22
最新のマクロ、計算書の送金先を正式通関と簡易通関の商品仕入先に転記が出来ています。
有難うございました。
これで８月からの新年度で使えます。感謝です。
今のところ変更するようなことはないと思っています。
しかし先で何か税理士さんの要望があった時には、
当該投稿を選んで質問を提示すればいいのでしょうか？
（数ヶ月なにも無いときに要望があればかなり遡っていかなければなりません。データが残っていれば良いですが？）
それとも何か方法があるでしょうか？
当該文章も長編になっていますので、他に方法がありますか？
（愛子） 2025/07/17(木) 21:54:27
でも、ちゃんと動作して良かったです。
いつも遅くまでやってるようなのでしっかり休んで目を休めてあげてくださいね(⌒▽⌒)
（通りすがり） 2025/07/17(木) 22:11:03
本当に足らない私に一生懸命になっていただき感謝です。
もちろんｘｙｚ様も同様です。
温かいお言葉、嬉しいです。
（愛子） 2025/07/17(木) 22:27:36
そうそう、海外送金の表ですが
毎月ごとにシートを変えていきたいのです。
例えば８月、８月が終われば
９月………最後に７月まで、
シート名は、今はsheet1ですが、
シート名を７月に変えれば構文も７月に変えるのでしょうか？
その度に構文を変えるのも面倒ですが
何か良い方法があるでしょうか？
明日で結構です。よろしくお願いします。
（愛子） 2025/07/17(木) 23:12:54
と、すれば大丈夫ですよ。
（通りすがり） 2025/07/18(金) 05:15:18
開いているシートということになるのですね。
わかりました。有難うございました。
（愛子） 2025/07/18(金) 06:09:04
Sub 海外送金_複数グループ完全版()
Dim ws As Worksheet, logWs As Worksheet
Set ws = ActiveSheet
On Error Resume Next
Set logWs = ThisWorkbook.Sheets("ログ")
If logWs Is Nothing Then
Set logWs = ThisWorkbook.Sheets.Add(After:=ws)
logWs.Name = "ログ"
Else
logWs.Cells.ClearContents
End If
On Error GoTo 0
logWs.Range("A1:E1").Value = Array("行番号", "対象セル", "区分", "条件一致", "理由")
Dim currentRow As Long, logRow As Long, i As Long
Dim groupStart As Long, groupEnd As Long
Dim formalEnd As Long, simpleEnd As Long, maxEndRow As Long, discountRow As Long
Dim pVal, uVal, vVal, adVal, aiVal, ajVal, rateCell As String
Dim gCount As Long, nCount As Long
currentRow = 6
logRow = 2
gCount = 0: nCount = 0
Do While ws.Cells(currentRow, "A").Value <> ""
groupStart = currentRow
Do While ws.Cells(currentRow, "A").Value <> ""
currentRow = currentRow + 1
Loop
groupEnd = currentRow - 1
'範囲判定
i = groupStart
Do While ws.Cells(i, "L").Value <> ""
i = i + 1
Loop
formalEnd = i - 1
i = groupStart
Do While ws.Cells(i, "Z").Value <> ""
i = i + 1
Loop
simpleEnd = i - 1
maxEndRow = Application.WorksheetFunction.Max(formalEnd, simpleEnd)
discountRow = maxEndRow + 1
rateCell = "E" & groupStart
'送金先転記
Dim payee As String
payee = ws.Cells(groupStart, "C").Value
ws.Range(ws.Cells(groupStart, "M"), ws.Cells(formalEnd, "M")).Value = payee
ws.Range(ws.Cells(groupStart, "AA"), ws.Cells(simpleEnd, "AA")).Value = payee
'正式通関
For i = groupStart To formalEnd
ws.Cells(i, "X").Formula = "=P" & i & "+R" & i
ws.Cells(i, "Q").Formula = "=P" & i & "*" & rateCell
ws.Cells(i, "S").Formula = "=R" & i & "*" & rateCell
ws.Cells(i, "T").Formula = "=A" & groupStart
ws.Cells(i, "U").Value = "三井住友/梅田"
ws.Cells(i, "W").Formula = "=" & rateCell
Next i
ws.Cells(formalEnd, "Y").Formula = "=SUM(X" & groupStart & ":X" & formalEnd & ")"
'簡易通関
For i = groupStart To simpleEnd
ws.Cells(i, "AL").Formula = "=AD" & i & "+AF" & i
ws.Cells(i, "AE").Formula = "=AD" & i & "*" & rateCell
ws.Cells(i, "AG").Formula = "=AF" & i & "*" & rateCell
ws.Cells(i, "AH").Formula = "=A" & groupStart
ws.Cells(i, "AI").Value = "三井住友/梅田"
ws.Cells(i, "AK").Formula = "=" & rateCell
Next i
ws.Cells(simpleEnd, "AM").Formula = "=SUM(AL" & groupStart & ":AL" & simpleEnd & ")"
'差額と値引き
ws.Cells(groupStart, "J").Formula = "=D" & groupStart & "-Y" & formalEnd & "-AM" & simpleEnd
ws.Cells(discountRow, "U").Value = "値引き"
ws.Cells(discountRow, "U").Interior.Color = RGB(255, 255, 0)
ws.Cells(discountRow, "V").Formula = "=D" & groupStart & "-Y" & formalEnd & "-AM" & simpleEnd
ws.Cells(discountRow, "Q").Formula = "=V" & discountRow & "*" & rateCell
'ログ記録（例簡略）
logWs.Cells(logRow, 1).Value = groupStart
logWs.Cells(logRow, 2).Value = "対象グループ開始"
logWs.Cells(logRow, 3).Value = "グループ"
logWs.Cells(logRow, 4).Value = "TRUE"
logWs.Cells(logRow, 5).Value = "正常処理完了"
logRow = logRow + 1
currentRow = discountRow + 2
Loop
ws.Range("G103").Value = gCount
ws.Range("N103").Value = nCount
MsgBox "複数グループ処理完了！", vbInformation
End Sub
Sub シートコピーと初期化()
Dim ws As Worksheet, newWs As Worksheet
Set ws = ActiveSheet
ws.Copy After:=ws
Set newWs = ActiveSheet
newWs.Range("A6:AL1000").ClearContents
MsgBox "シートをコピー＆初期化しました！", vbInformation
End Sub
Sub ボタン追加()
Dim ws As Worksheet
Set ws = ActiveSheet
With ws.Buttons.Add(50, 50, 100, 30)
.OnAction = "海外送金_複数グループ完全版"
.Caption = "マクロ実行"
End With
With ws.Buttons.Add(50, 100, 150, 30)
.OnAction = "シートコピーと初期化"
.Caption = "次月シートコピー"
End With
MsgBox "ボタンを追加しました！", vbInformation
End Sub
これを、７月シートを開いて実行すると「実行ボタン」と「次月シートコピー」
の２つのボタンができます
次月シートコピーを、実行すると翌月分シートが作成されます
それと同時に先月分シートからはボタンが削除されます。
（通りすがり） 2025/07/18(金) 07:43:54
今、会社に着きました。
何気なく開きましたが、
良かったです。
自宅に帰ってからトライします。
重ね重ね有難うございました。
（愛子） 2025/07/18(金) 09:52:40
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.