エクセルのシート間で複数条件にて照合させたい。

質問

１．【Sheet1のデータ例】※補助元帳データ（Excel）
----------------------------------------------------------------------------------
A B C D E F G H ・・・・
1| No. 日付 区分A 区分B 取引先 借方 貸方
2| 78 2/1 A 1010 A商事 5,000
3| 12 2/1 B 1020 B商事 2,000
4| 50 2/1 A 1050 C(カ) 1,050
5| 44 2/2 A 1100 (カ)D 8,400
6| 94 2/3 C 1700 (ユ)Q 5,500
7| 51 2/4 B 1010 P興業 4,200
・| ・ ・ ・ ・ ・ ・ ・
・| ・ ・ ・ ・ ・ ・ ・
・| ・ ・ ・ ・ ・ ・ ・
----------------------------------------------------------------------------------

２．【Sheet2のデータ例】※入金データ（Excel）
----------------------------------------------------------------------------------
A B C D E F G H ・・・・
1| 日付 区分 借方 貸方 摘要
2| 2/1 CC 1,050
3| 2/1 2,000
4| 2/1 5,000
5| 2/2 CC 8,400
6| 2/3 5,500
7| 2/4 CC 4,200
・| ・ ・ ・ ・ ・ ・ ・
・| ・ ・ ・ ・ ・ ・ ・
・| ・ ・ ・ ・ ・ ・ ・
----------------------------------------------------------------------------------

上記のようなエクセル シートがあります

1.[sheet1]と[sheet2]の日付と金額を照合させて2つの条件が一致するデータを探す
2.一致するデータの行を[sheet1]と[sheet2]ともに塗りつぶしをする(薄い黄色)
3.日付と金額が一致している行が複数あるなら対象データ(行)を薄いピンクに塗りつぶす
4.一致しないデータを[sheet3]に日付と金額のみ貼り付ける

上記のようなことをしたいのですが
関数では限界があり悩んでいます。
VBAを試してみたいのですが知恵を拝借できないでしょうか。
よろしくお願い致します。

回答No.7

ham_kamo · ベストアンサー

できあがったVBAです。標準モジュールにコピーして貼り付けて実行してください。最初の方のシート名や列名が実際のものと異なったら、その部分を書き換えてください。

Sub データ照合()
　Dim WS(3) As Worksheet
　Set WS(1) = Worksheets("Sheet1") '補助元帳データのシート名
　Set WS(2) = Worksheets("Sheet2") '入金データのシート名
　Set WS(3) = Worksheets("Sheet3") '一致しないデータのシート名

　Dim WS3Title(2) As String '一致しないデータのシートのタイトル
　WS3Title(1) = "補助元帳不一致データ（入金データに存在しないデータ）"
　WS3Title(2) = "入金不一致データ（補助元帳に存在しないデータ）"

　Dim WSKari(2) As String
　Dim WSKashi(2) As String
　Dim WSAll(2) As Integer
　Dim WSDate(2) As String

　WSDate(1) = "A" '補助元帳データの日付列
　WSKari(1) = "J" '補助元帳データの借方列
　WSKashi(1) = "K" '補助元帳データの貸方列
　WSAll(1) = 11 '補助元帳データの列数

　WSDate(2) = "B" '入金データの日付列
　WSKari(2) = "D" '入金データの借方列
　WSKashi(2) = "E" '入金データの貸方列
　WSAll(2) = 12 '入金データの列数

　Const WS3Date As String = "A" '一致しないデータの日付列
　Const WS3Kari As String = "B" '一致しないデータの借方列
　Const WS3Kashi As String = "C" '一致しないデータの貸方列

　Dim Color(2) As Integer
　Color(0) = xlColorIndexNone '無色
　Color(1) = 36 '１つだけ一致する色（薄い黄色）
　Color(2) = 38 '複数一致する色（薄いピンク）

　Dim WS1Num() As Integer, WS2Num() As Integer 'それぞれのシートの重複データ数
　Dim WSCount(2) As Integer 'それぞれのシートのデータ数
　Dim Count As Integer, n As Integer, i1 As Integer, i2 As Integer

　Application.ScreenUpdating = False

　'最初に両シートの背景色をクリア
　WS(1).Range("A1").CurrentRegion.Interior.ColorIndex = Color(0)
　WS(2).Range("A1").CurrentRegion.Interior.ColorIndex = Color(0)

　'マッチング開始
　WSCount(1) = WS(1).Cells(Rows.Count, WSDate(1)).End(xlUp).Row
　WSCount(2) = WS(2).Cells(Rows.Count, WSDate(2)).End(xlUp).Row
　ReDim WS1Num(WSCount(1))
　ReDim WS2Num(WSCount(2))
　ReDim WS1NoMatch(WSCount(1))
　ReDim WS2NoMatch(WSCount(2))

　'１パス目：各シート内で同日付、同金額のデータ検索
　'テンポラリのシートを追加
　Dim TmpWS As Worksheet
　With Worksheets
　　Set TmpWS = .Add(after:=Worksheets(.Count))
　End With
　For n = 1 To 2 'シートのループ
　　For i1 = 1 To 2 '借方と貸方のループ
　　　TmpWS.Cells.ClearContents
　　　'テンポラリのシートに日付と金額をコピー
　　　TmpWS.Rows(1).Delete
　　　For i2 = 2 To WSCount(n) + 1
　　　　If i1 = 1 And WS(n).Cells(i2, WSKari(n)) <> "" Then
　　　　　TmpWS.Cells(i2, "A") = WS(n).Cells(i2, WSDate(n))
　　　　　TmpWS.Cells(i2, "B") = WS(n).Cells(i2, WSKari(n))
　　　　　TmpWS.Cells(i2, "C") = i2
　　　　ElseIf i1 = 2 And WS(n).Cells(i2, WSKashi(n)) <> "" Then
　　　　　TmpWS.Cells(i2, "A") = WS(n).Cells(i2, WSDate(n))
　　　　　TmpWS.Cells(i2, "B") = WS(n).Cells(i2, WSKashi(n))
　　　　　TmpWS.Cells(i2, "C") = i2
　　　　End If
　　　Next
　　　'日付と金額でソート
　　　TmpWS.Columns("A:C").Sort Key1:=Range("A1"), Key2:=Range("B1"), Header:=xlNo
　　　For i2 = 1 To TmpWS.Cells(Rows.Count, 1).End(xlUp).Row
　　　　If n = 1 Then
　　　　　If i2 = 1 Then
　　　　　　If TmpWS.Cells(i2, "A") = TmpWS.Cells(i2 + 1, "A") _
　　　　　　And TmpWS.Cells(i2, "B") = TmpWS.Cells(i2 + 1, "B") Then
　　　　　　　WS1Num(TmpWS.Cells(i2, "C")) = 2
　　　　　　Else
　　　　　　　WS1Num(TmpWS.Cells(i2, "C")) = 1
　　　　　　End If
　　　　　Else
　　　　　　If TmpWS.Cells(i2, "A") = TmpWS.Cells(i2 - 1, "A") _
　　　　　　And TmpWS.Cells(i2, "B") = TmpWS.Cells(i2 - 1, "B") _
　　　　　　Or TmpWS.Cells(i2, "A") = TmpWS.Cells(i2 + 1, "A") _
　　　　　　And TmpWS.Cells(i2, "B") = TmpWS.Cells(i2 + 1, "B") Then
　　　　　　　WS1Num(TmpWS.Cells(i2, "C")) = 2
　　　　　　Else
　　　　　　　WS1Num(TmpWS.Cells(i2, "C")) = 1
　　　　　　End If
　　　　　End If
　　　　Else
　　　　　If i2 = 1 Then
　　　　　　If TmpWS.Cells(i2, "B") = TmpWS.Cells(i2 + 1, "B") Then
　　　　　　　WS2Num(TmpWS.Cells(i2, "C")) = 2
　　　　　　Else
　　　　　　　WS2Num(TmpWS.Cells(i2, "C")) = 1
　　　　　　End If
　　　　　Else
　　　　　　If TmpWS.Cells(i2, "B") = TmpWS.Cells(i2 - 1, "B") _
　　　　　　Or TmpWS.Cells(i2, "B") = TmpWS.Cells(i2 + 1, "B") Then
　　　　　　　WS2Num(TmpWS.Cells(i2, "C")) = 2
　　　　　　Else
　　　　　　　WS2Num(TmpWS.Cells(i2, "C")) = 1
　　　　　　End If
　　　　　End If
　　　　End If
　　　Next
　　Next
　Next
　Application.DisplayAlerts = False
　TmpWS.Delete
　Application.DisplayAlerts = True

　'２パス目：両シートをつきあわせて色をつける
　For i1 = 2 To WSCount(1)
　　Application.StatusBar = "処理実行中 " & i1 & "/" & WSCount(1) & "完了"
　　For i2 = 2 To WSCount(2)
　　　If WS(1).Cells(i1, WSDate(1)) = WS(2).Cells(i2, WSDate(2)) Then
　　　　If WS(1).Cells(i1, WSKari(1)) <> "" _
　　　　And WS(1).Cells(i1, WSKari(1)) = WS(2).Cells(i2, WSKari(2)) _
　　　　Or WS(1).Cells(i1, WSKashi(1)) <> "" _
　　　　And WS(1).Cells(i1, WSKashi(1)) = WS(2).Cells(i2, WSKashi(2)) Then
　　　　　WS(1).Cells(i1, 1).Resize(1, WSAll(1)).Interior.ColorIndex = _
　　　　　　Color(Application.WorksheetFunction.Max(WS1Num(i1), WS2Num(i2)))
　　　　　WS(2).Cells(i2, 1).Resize(1, WSAll(2)).Interior.ColorIndex = _
　　　　　　Color(Application.WorksheetFunction.Max(WS1Num(i1), WS2Num(i2)))
　　　　End If
　　　End If
　　Next
　Next

　'最終ステップ：一致しないデータのシート作成
　Dim WS3Row As Integer '一致しないデータを記入する行番号
　WS3Row = 1
　WS(3).UsedRange.ClearContents
　For n = 1 To 2
　　'タイトル作成
　　WS(3).Cells(WS3Row, "A").Value = WS3Title(n)
　　WS3Row = WS3Row + 1
　　WS(3).Cells(WS3Row, WS3Date).Value = "日付"
　　WS(3).Cells(WS3Row, WS3Kari).Value = "借方"
　　WS(3).Cells(WS3Row, WS3Kashi).Value = "貸方"

　　'一致しないデータを転記
　　For i1 = 1 To WSCount(n)
　　　If WS(n).Cells(i1 + 1, WSDate(n)).Interior.ColorIndex = Color(0) Then
　　　　WS3Row = WS3Row + 1
　　　　WS(3).Cells(WS3Row, WS3Date) = WS(n).Cells(i1 + 1, WSDate(n))
　　　　WS(3).Cells(WS3Row, WS3Kari) = WS(n).Cells(i1 + 1, WSKari(n))
　　　　WS(3).Cells(WS3Row, WS3Kashi) = WS(n).Cells(i1 + 1, WSKashi(n))
　　　End If
　　Next
　　WS3Row = WS3Row + 1
　Next
　Application.StatusBar = ""
　MsgBox "完了しました", vbInformation
End Sub

お礼

いつもありがとうございます。
早速ダミーデータを入れてマクロを実行しました。
完了です！というメッセージがでて
各シートをみると塗りつぶし、不一致データの転記がされないのです。
自分ではどうしてこうなるのかわかりません。
注記(緑の説明文)の通りにシート名や項目列を書き換えて実行しました。
原因をどうやって追究したらよいか…
最後のメッセージまでエラーはありませんでした。
なぜなのでしょう。
もう一度見直してみます。

回答No.10

ham_kamo

すみません、最後の最後でミスがありました。
ワーク用のシート、実は最初は１枚だけ追加して、それを使いまわしてから削除していたのですが、途中経過のチェック用に、各シートの借方、貸方用に別々に追加するように変更したのでした。削除の部分はそのままだったので、確かにそれでは１枚しか削除されません。

　'１パス目：各シート内で同日付、同金額のデータ検索
　'テンポラリのシートを追加
　Dim TmpWS As Worksheet
　For n = 1 To 2 'シートのループ
　　For i1 = 1 To 2 '借方と貸方のループ
　　　With Worksheets
　　　　Set TmpWS = .Add(after:=Worksheets(.Count))
　　　　TmpWS.Columns("A").NumberFormatLocal = "m/d"
　　　End With

となっているところを、以下に変更していただけますか？

　'１パス目：各シート内で同日付、同金額のデータ検索
　'テンポラリのシートを追加
　Dim TmpWS As Worksheet
　With Worksheets
　　Set TmpWS = .Add(after:=Worksheets(.Count))
　End With
　For n = 1 To 2 'シートのループ
　　For i1 = 1 To 2 '借方と貸方のループ

お礼

できました！できました！
感動です！
不一致以降のシートがすべて削除されています。

まったく何も無いところから作り上げられるなんて
発想力と想像力が豊かでないと難しそうですね。
挫折しないようにがんばります。
決め細やかな対応をありがとうございました。

回答No.9

ham_kamo

うまく動いたようでよかったです。やっと安心できました。

背景色のクリアですが、

> WS(1).Range("A1").CurrentRegion.Interior.ColorIndex = Color(0)
> WS(2).Range("A1").CurrentRegion.Interior.ColorIndex = Color(0)

のA1は、その表の中ならどこでもいいのですが、左上なら表のタイトルが入っているだろう、と思ってA1としました。ここを各シートのタイトル行の１番左の列のセル番地に変えればいいはずです。

ただ、やり方は他にもあって、上記は「実際の表の範囲を取得して、その範囲だけを背景色をクリア」という操作なのですが（こうしたのは、表の範囲以外の場所に注意書きなどで色のついたセルがあった場合、それもクリアしてしまうといけないから、と思ったからです）、

シートでデータが入っている領域全ての背景色をクリアするときは、
WS(1).UsedRange.Interior.ColorIdex = Color(0)
WS(2).UsedRange.Interior.ColorIdex = Color(0)

シートの全セルの背景色をクリアするには、
WS(1).Cells.Interior.ColorIdex = Color(0)
WS(2).Cells.Interior.ColorIdex = Color(0)

と書くことができます。

それから、うまくいったのであれば、マクロの中で追加している４つのワーク用のシートを削除する部分を今コメントアウト（'をつけて注釈文扱いにすること）しているので、

'TmpWS.Delete

という行の行頭の'を外してください。どこに書いているのが探すのが大変！と思ったときは、VBAの画面でCtrl+Fを押せば検索できます。
これをやれば、マクロを実行してもワーク用のシートが残ることはありません。

> 余談ですが、今日数冊のＶＢＡ書籍を購入しました。
> ham_kamo様のようにマクロが書けるようになりたいです。

マクロは敷居が高いと思われているかも知れませんが、いきなり難しいことをやろうとせずに、入門書に沿ってVBAの文法やオブジェクトの扱い方を１つずつ覚えて行けば、少しずつできることが多くなってくると思います。

私は「この操作をマクロで書くにはどうしたらいいんだろう？」というのがわからないときは、「マクロの記録」機能を使ってその操作を記録してみて、記録されたマクロを見て、わからないキーワードが出てきたらヘルプや書籍やネットで調べる、ということを繰り返してきました。ネットにもわかりやすいサンプルを解説したサイトがたくさんあるので活用するとよいと思います。がんばってくださいね。

お礼

背景色のクリアのエラーはそういうことだったのですね。
既存シートのことお気遣いありがとうございます。
そして勉強になりました。（＾＾）

シート削除のところなのですが…
ham_kamo 様に教えていただいた通りに'TmpWS.Deleteのコメントアウトをしました。
マクロを再度実行したところ、不一致シートのうしろに３シート残っています。

でも…１枚だけは削除されています。
原因を自力で見つけようと今日一日努力をしてみましたがどうしても見つかりません。

どうか再度ご指南いただけませんでしょうか(T.T)

下記の通りにしました。

Application.DisplayAlerts = False
TmpWS.Delete
Application.DisplayAlerts = True

やりたいことをマクロの記録を使ってやってみてＶＢＡを学習したいと思います。
参考書を読みふけるよりも覚えられそうです。
ありがとうございます。
ham_kamo 様にいろいろとご教授いただいたことでＶＢＡを学ぼうという気持ちになりました。
がんばりまっす！！

回答No.8

ham_kamo

うまく動きませんでしたか…。
原因として一番考えられるのは、列名が違っていることなのですが…。

私の方でVBAを見直して、少し冗長だったのを短くしてみました。やっていることは同じですが、下のマクロに置きかえていただけますか？

それを貼り付けて実行してから確認してほしいのが、このマクロではダブりチェック用に一時的にシートを挿入し、元のシートから日付と金額をコピーしてソート、ということを行っています。その一時シートは処理が終わると削除していましたが、下記のマクロでは検証のため、削除していません。そのシートの内容を確認してください。

追加されるシートは一番うしろに４つで、それぞれ「補助元帳データの借方」「補助元帳データの貸方」「入金データの借方」「入金データの貸方」を抜き出して、Ａ列に日付、Ｂ列に金額、Ｃ列に数字（元の表での行番号が入っています。これが、それぞれのシートできちんと日付と金額になっているかを確認してください。日付と金額になっていなければ、列名の設定ミスの可能性が高いです。

一時シートをマクロの中で削除していないので、実行するたびにうしろの４枚のシートは手で削除してください。

Sub データ照合()
　Dim WS(3) As Worksheet
　Set WS(1) = Worksheets("Sheet1") '補助元帳データのシート名
　Set WS(2) = Worksheets("Sheet2") '入金データのシート名
　Set WS(3) = Worksheets("Sheet3") '一致しないデータのシート名

　Dim WS3Title(2) As String '一致しないデータのシートのタイトル
　WS3Title(1) = "補助元帳不一致データ（入金データに存在しないデータ）"
　WS3Title(2) = "入金不一致データ（補助元帳に存在しないデータ）"

　Dim WSMoney(2, 2) As String
　Dim WSAll(2) As Integer
　Dim WSDate(2) As String

　WSDate(1) = "A" '補助元帳データの日付列
　WSMoney(1, 1) = "J" '補助元帳データの借方列
　WSMoney(1, 2) = "K" '補助元帳データの貸方列
　WSAll(1) = 11 '補助元帳データの列数

　WSDate(2) = "B" '入金データの日付列
　WSMoney(2, 1) = "D" '入金データの借方列
　WSMoney(2, 2) = "E" '入金データの貸方列
　WSAll(2) = 12 '入金データの列数

　Const WS3Date As String = "A" '一致しないデータの日付列
　Const WS3Kari As String = "B" '一致しないデータの借方列
　Const WS3Kashi As String = "C" '一致しないデータの貸方列

　Dim Color(2) As Integer
　Color(0) = xlColorIndexNone '無色
　Color(1) = 36 '１つだけ一致する色（薄い黄色）
　Color(2) = 38 '複数一致する色（薄いピンク）

　Dim WSNum() As Integer 'それぞれのシートの重複データ数
　Dim WSCount(2) As Integer 'それぞれのシートのデータ数
　Dim Count As Integer, n As Integer, i1 As Integer, i2 As Integer

　Application.ScreenUpdating = False

　'最初に両シートの背景色をクリア
　WS(1).Range("A1").CurrentRegion.Interior.ColorIndex = Color(0)
　WS(2).Range("A1").CurrentRegion.Interior.ColorIndex = Color(0)

　'マッチング開始
　WSCount(1) = WS(1).Cells(Rows.Count, WSDate(1)).End(xlUp).Row
　WSCount(2) = WS(2).Cells(Rows.Count, WSDate(2)).End(xlUp).Row
　ReDim WSNum(2, Application.WorksheetFunction.Max(WSCount(1), WSCount(2)))

　'１パス目：各シート内で同日付、同金額のデータ検索
　'テンポラリのシートを追加
　Dim TmpWS As Worksheet
　For n = 1 To 2 'シートのループ
　　For i1 = 1 To 2 '借方と貸方のループ
　　　With Worksheets
　　　　Set TmpWS = .Add(after:=Worksheets(.Count))
　　　　TmpWS.Columns("A").NumberFormatLocal = "m/d"
　　　End With

　　　TmpWS.Cells.ClearContents
　　　'テンポラリのシートに日付と金額をコピー
　　　For i2 = 2 To WSCount(n) + 1
　　　　If WS(n).Cells(i2, WSMoney(n, i1)) <> "" Then
　　　　　TmpWS.Cells(i2, "A") = WS(n).Cells(i2, WSDate(n))
　　　　　TmpWS.Cells(i2, "B") = WS(n).Cells(i2, WSMoney(n, i1))
　　　　　TmpWS.Cells(i2, "C") = i2
　　　　End If
　　　Next

　　　'日付と金額でソート
　　　TmpWS.Columns("A:C").Sort Key1:=Range("A2"), Key2:=Range("B2"), Header:=xlYes

　　　'重複チェック
　　　For i2 = 2 To WSCount(n) + 1
　　　　If TmpWS.Cells(i2, "A") = TmpWS.Cells(i2 - 1, "A") _
　　　　And TmpWS.Cells(i2, "B") = TmpWS.Cells(i2 - 1, "B") _
　　　　Or TmpWS.Cells(i2, "A") = TmpWS.Cells(i2 + 1, "A") _
　　　　And TmpWS.Cells(i2, "B") = TmpWS.Cells(i2 + 1, "B") Then
　　　　　WSNum(n, TmpWS.Cells(i2, "C")) = 2
　　　　Else
　　　　　WSNum(n, TmpWS.Cells(i2, "C")) = 1
　　　　End If
　　　Next
　　Next
　Next
　Application.DisplayAlerts = False
　'TmpWS.Delete
　Application.DisplayAlerts = True

　'２パス目：両シートをつきあわせて色をつける
　For i1 = 2 To WSCount(1)
　　Application.StatusBar = "処理実行中 " & i1 & "/" & WSCount(1) & "完了"
　　For i2 = 2 To WSCount(2)
　　　If WS(1).Cells(i1, WSDate(1)) = WS(2).Cells(i2, WSDate(2)) Then
　　　　If WS(1).Cells(i1, WSMoney(1, 1)) <> "" _
　　　　And WS(1).Cells(i1, WSMoney(1, 1)) = WS(2).Cells(i2, WSMoney(2, 1)) _
　　　　Or WS(1).Cells(i1, WSMoney(1, 2)) <> "" _
　　　　And WS(1).Cells(i1, WSMoney(1, 2)) = WS(2).Cells(i2, WSMoney(2, 2)) Then
　　　　　WS(1).Cells(i1, 1).Resize(1, WSAll(1)).Interior.ColorIndex = _
　　　　　　Color(Application.WorksheetFunction.Max(WSNum(1, i1), WSNum(2, i2)))
　　　　　WS(2).Cells(i2, 1).Resize(1, WSAll(2)).Interior.ColorIndex = _
　　　　　　Color(Application.WorksheetFunction.Max(WSNum(1, i1), WSNum(2, i2)))
　　　　End If
　　　End If
　　Next
　Next

　'最終ステップ：一致しないデータのシート作成
　Dim WS3Row As Integer '一致しないデータを記入する行番号
　WS3Row = 1
　WS(3).UsedRange.ClearContents
　For n = 1 To 2
　　'タイトル作成
　　WS(3).Cells(WS3Row, "A").Value = WS3Title(n)
　　WS3Row = WS3Row + 1
　　WS(3).Cells(WS3Row, WS3Date).Value = "日付"
　　WS(3).Cells(WS3Row, WS3Kari).Value = "借方"
　　WS(3).Cells(WS3Row, WS3Kashi).Value = "貸方"

　　'一致しないデータを転記
　　For i1 = 1 To WSCount(n)
　　　If WS(n).Cells(i1 + 1, WSDate(n)).Interior.ColorIndex = Color(0) Then
　　　　WS3Row = WS3Row + 1
　　　　WS(3).Cells(WS3Row, WS3Date) = WS(n).Cells(i1 + 1, WSDate(n))
　　　　WS(3).Cells(WS3Row, WS3Kari) = WS(n).Cells(i1 + 1, WSMoney(n, 1))
　　　　WS(3).Cells(WS3Row, WS3Kashi) = WS(n).Cells(i1 + 1, WSMoney(n, 2))
　　　End If
　　Next
　　WS3Row = WS3Row + 1
　Next
　Application.StatusBar = ""
　MsgBox "完了しました", vbInformation
End Sub

お礼

ham_kamo様、いつもお世話になってます。
上記のマクロを実行しました。
できました！！できました！！鳥肌感動ものです。
素敵です！芸術的です。
ありがとうございます。
余談ですが、今日数冊のＶＢＡ書籍を購入しました。
ham_kamo様のようにマクロが書けるようになりたいです。

教えていただいたマクロを１回目に実行したところ下のステートメントでエラーメッセージがでました。
エラー番号'1004'でした。
「Range("A1").CurrentRegionを取得できません」といったことが表示されました。
で、ヘルプなどで調べてみて空白があるとエラーがでるというようなことが書いてあったので入金データ１列目に(空白だったので)データを入れてみました。
そしたら成功！
ただ入金データの１列目はデータが入っていない行もあるのでその場合にエラーが出ないようにするにはどうしたらいいでしょうか。
１列目に空白のセルがあっても無視できる方法はありますでしょうか？

>最初のシートの背景色をクリア
> WS(1).Range("A1").CurrentRegion.Interior.ColorIndex = Color(0)
> WS(2).Range("A1").CurrentRegion.Interior.ColorIndex = Color(0)

回答No.6

ham_kamo

> シートの状態をお見せした方がよさそうなので
> どこかへデータ保存する場所を探します。

えっと、そういうファイルのやり取りはこのサイトではあまり好ましくないと思われていたような気がするので、そこまでしなくてもいいです。

とりあえずマクロはできたので、次の回答でアップします。（長くなるので）

そのマクロの最初の方で、各シートの実際のシート名、各シートの各項目の列名を定義しています。注釈をつけているので、それを見て実際のシートにあうように変更してください。とりあえず今は、補足欄に書いていただいた列番号（ＡとかＢとか列名ですが）を指定しています。

また、こういう複雑な処理の場合、後から想定しなかったケースというのが出る可能性があります。今回も何回も不明な点を補足していただくようにお願いしましたが、それでも漏れがあるかもしれません。

まずはいきなり本物のデータで使うというより、ご自身でもいくつかのパターンで試してみてから、実際の業務でお使いいただく方がよいと思います。

それで、しばらくはこの質問を締め切らないでください。ここのサイトでは締め切ってしまうと、考慮漏れやマクロに不具合があって、後からk_a_z様が何か補足しようと思っても、私に伝えることができません。また、このサイトはお礼欄や補足欄を使い切ってしまうと、やはり回答者に連絡することができなくなりますのでご注意ください。

使っていて不具合があったら、この回答や以前の回答、次にアップするマクロの回答でもいいので、補足欄やお礼欄から補足をお願いします。補足やお礼が書かれるとメールが来るように設定しておりますので、こちらも気づくかと思います。

補足

いつもお世話になっております。(~-~)(_ _)ペコリ

>えっと、そういうファイルのやり取りはこのサイトではあまり好ましくないと
>思われていたような気がするので、そこまでしなくてもいいです。

確かに、了解致しました。
いろいろ配慮をいただきありがとうございます。
それにマクロまで作っていただき感謝です。
早速今から実行してみます。
試してみてまた質問をさせていただいてよろしいでしょうか？

説明が不足したにもかかわらず諦めずにお付き合いをいただき
ありがとうございます。
とっても助かりました。
私もham_kamo様のようにマクロを自分でも作ってみたいです。

またよろしくお願いいたします。m(__)m

回答No.5

ham_kamo

すみません、何度も補足要求ばかりで恐縮ですが、

> 今日職場でシートを開き項目を確認したところ
> 記憶違いだったことがわかりました。
>
> 入金データの項目は１２項目
> 日付は２列目
> 補助簿の項目は１１項目
> 日付は１列目
> が正しいのです。

とあるのですが、No.3の補足と変わっていません。
入金データと補助簿が丸ごと入れ替わって記載されている、ということはありませんか？（借方、貸方の列も含めて）

補足

いつもお世話になります。

シートの状態をお見せした方がよさそうなので
どこかへデータ保存する場所を探します。
データ内容は削除をして列と行、項目のところを見ていただけますか？

うまく伝えることができなくてすみません…

回答No.4

ham_kamo

片方に重複データがなくても、もう一方のシートでそのデータが２件以上あれば薄いピンクにする、ということですね。了解しました。

それで、ちょっと気になったのが、質問文の例では
１．【Sheet1のデータ例】※補助元帳データ（Excel）
----------------------------------------------------------------------------------
A B C D E F G H ・・・・
1| No. 日付 区分A 区分B 取引先 借方 貸方
2| 78 2/1 A 1010 A商事 5,000

と補助元帳データでは先頭の列にNo.というのが入っていて、

２．【Sheet2のデータ例】※入金データ（Excel）
----------------------------------------------------------------------------------
A B C D E F G H ・・・・
1| 日付 区分 借方 貸方 摘要
2| 2/1 CC 1,050

と入金データは日付から始まっています。

> ●補足の宿題ですが
> 入金データの項目は１２項目
> 日付は２列目
>
> 補助簿の項目は１１項目
> 日付は１列目

とのことですが、これはこれでよいのでしょうか？質問文の例を見ると、補助簿にはNo.があるので２列目以降のような気がするのですが…

補足

今日職場でシートを開き項目を確認したところ
記憶違いだったことがわかりました。

入金データの項目は１２項目
日付は２列目
補助簿の項目は１１項目
日付は１列目
が正しいのです。
混乱をさせてしまいすみませんでした。

回答No.3

ham_kamo

すみませんが、また補足をお願いできますか？

借方側、貸方側それぞれで、一対複数の一致というのはあるのでしょうか。

たとえば、

補助元帳データ

日付　　借方　　貸方
2/1　　2000　　　　　　←ここの色は？　　
2/1　　5000　　　　　　
2/1　　2000　　　　　　←ここの色は？　　

入金データ
日付　　借方　　貸方
2/1　　2000　　　　　　←ここの色は？
2/1　　　　　　　3000

のように、片方には同じ日付と金額のパターンが複数あるのに、もう片方にはその組み合わせが１つしかない、となる場合はあるのでしょうか。ある場合、どのように色をつけたらよいでしょうか。

作り始めたはいいのですが、いろんなパターンがあるので、思ったよりもけっこう難しそうです。ちょっとお時間をいただくことになるかもしれません。

補足

補助元帳データ
日付　　借方　　貸方
2/1　　2000　　　　　　←薄いピンク　
2/1　　5000　　　　　　
2/1　　2000　　　　　　←薄いピンク

入金データ
日付　　借方　　貸方
2/1　　2000　　　　　　←薄いピンク
2/1　　　　　　　3000

補助簿から見て(日付＆金額で同じもの複数あり）入金データに１件しか一致しない場合でも薄いピンクで塗りつぶしをする、というのは可能ですか？
入金データからみて補助簿に対しても同様で
入金データには日付＆金額で同じもの複数あり、補助簿に一致するデータ(日付＆金額が同じもの１件）でも入金データの行を薄いピンクで塗りつぶしたいです。

●補足の宿題ですが
入金データの項目は１２項目
日付は２列目
借方(入金)は４列目
貸方(出金)は５列目

補助簿の項目は１１項目
日付は１列目
借方は１０列目
貸方は１１列目です。

宜しくお願い致します。m(_ _)m

回答No.2

ham_kamo

No.1です。すみませんが、もう少し確認しておきたいことが出てきたので、補足をお願いできますか？

> 両シートで借方金額と日付が一致するもの、貸方金額と日付が一致するものが
> 借方、貸方それぞれ２行以上あれば塗りつぶしたいです。

借方、貸方「それぞれ」なのですね。それで、この「一致するものが２行」のところ、もうちょっと厳密にお伺いしたいです。
たとえば、

補助元帳データ
日付　　借方　　貸方
2/1　　2000
2/1　　3000
2/1　　　　　　　2000
2/2　　　　　　　3000

入金データ
日付　　借方　　貸方
2/1　　2000
2/1　　3000
2/1　　　　　　　2000
2/2　　　　　　　3000

となっていたとき、借方、貸方ともに日付と金額が一致するのは２行ずつあります。この場合に薄いピンクにするのか、

あるいは、借方、貸方ともに「2/1に2000円」「2/1に3000円」というのが１組ずつあるので、これらは「一致している行が１行」とみなし、薄い黄色にするのでしょうか。

要は、「日付と金額が一致する」というのは、「同じ日付と同じ金額の組が２行以上あれば」なのか、金額は違っても「日付と金額が一致する行が２行以上あれば」なのか、その点を補足願えますか？

次に、一致しないデータのシートですが、これは両方のシートから抜き出したものを日付順に並べればよいでしょうか。それとも補助元帳データシートから抜き出したものをまず並べ、その下に入金データから抜き出したものを並べればよいでしょうか。

それから、質問文の表では、
１．【Sheet1のデータ例】※補助元帳データ（Excel）
----------------------------------------------------------------------------------
A B C D E F G H ・・・・

２．【Sheet2のデータ例】※入金データ（Excel）
----------------------------------------------------------------------------------
A B C D E F G H ・・・・

と列名の後に・・・・とありますが、それぞれのシートには項目上記以外にあるのでしょうか。その場合、それぞれのシートはＡ列目から何列目までデータが入っているのか教えてください。

最後に、全体のデータ数は何件くらいあるのでしょうか。あまり多いと処理に時間がかかるかもしれないので、マクロの記述を工夫しないといけないかもしれません。実際のデータ数だけダミーデータを入れて試してみたいので、教えていただけますでしょうか。

補足要求ばかりで恐縮ですが、実際に作り出すと、いろいろと詳細をお聞きしないといけない点が新たに出てたので、以上の件の補足をお願いします。（また補足のお願いをするかもしれませんが…）

途中まで作成しかけていますが、上記の条件しだいによっては、ちょっと苦戦するかもしれないので、多少お時間をいただくかもしれません。

補足

説明不足ですみません。

● 一対または複数条件の塗りつぶしについて

【補助元帳データ】と【入金データ】借方側での日付と金額一致、
【補助元帳データ】と【入金データ】貸方側での日付と金額一致の照合をしたいのです。
借方側での一対一致を黄色、貸方側での一対一致で黄色
借方側での複数一致を薄いピンク、貸方側での複数一致で薄いピンク

【下記の場合は一対のパターン】
補助元帳データ
日付　　借方　　貸方
2/1　　2000　　　　　　←黄色
2/1　　5000　　　　　　←補助元帳不一致データとしてsheet3へ転記
2/1　　3000　　　　　　←黄色
2/1　　　　　　　2000　←黄色
2/2　　　　　　　3000　←黄色

入金データ
日付　　借方　　貸方
2/1　　2000　　　　　　←黄色
2/1　　3000　　　　　　←黄色
2/1　　　　　　　2000　←黄色
2/2　　　　　　　3000　←黄色
2/3　　　　　　　1000←補助元帳不一致データとしてsheet3へ転記

【下記の場合は複数のパターン】
補助元帳データ
日付　　借方　　貸方
2/1　　2000　　　　　　←薄いピンク
2/1　　5000　　　　　　←補助元帳不一致データとしてsheet3へ転記
2/1　　2000　　　　　　←薄いピンク
2/1　　　　　　　3000　←薄いピンク
2/1　　　　　　　3000　←薄いピンク

入金データ
日付　　借方　　貸方
2/1　　2000　　　　　　←薄いピンク
2/1　　2000　　　　　　←薄いピンク
2/1　　　　　　　3000　←薄いピンク
2/1　　　　　　　3000　←薄いピンク
2/3　　　　　　　1000←補助元帳不一致データとしてsheet3へ転記

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

>次に、一致しないデータのシートですが、これは両方のシートから抜き出したものを
>日付順に並べればよいでしょうか。
>それとも補助元帳データシートから抜き出したものをまず並べ、その下に
>入金データから抜き出したものを並べればよいでしょうか。

● 一致しないデータ（別シート転記）について

補助元帳不一致データ（入金データに存在しないデータ）
日付　　借方　　貸方
2/1　　5000

入金不一致データ（補助元帳に存在しないデータ）
日付　　借方　　貸方
2/3　　　　　　　1000

上記は同一シートの上下に位置する形を希望しています。
また別のシートでもＯＫです。

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

>それぞれのシートには項目上記以外にあるのでしょうか。
>その場合、それぞれのシートはＡ列目から何列目までデータが入っているのか教えてください。

● 項目の列数について

すみません、今自宅からなのでデータの列数については今日中（午後か夜）に必ず補足をいたします。

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

>全体のデータ数は何件くらいあるのでしょうか。
>あまり多いと処理に時間がかかるかもしれないので、マクロの記述を工夫しないといけないかもしれません。
>実際のデータ数だけダミーデータを入れて試してみたいので、教えていただけますでしょうか。

そ、そんな、すみません！ダミーデータを入れて試作をしていただいているなんて！
感激です。ありがとうございます。
私の説明があいまいで申し訳ありません。
補足も長々と入れてしまいました。
項目の列数に関して急ぎ補足をします。何卒お付き合いの程お願いいたします。
感謝、感謝です。ありがとうございます。

● 件数について

最大と思われる件数（月によって件数が異なる為）４００件
少ないときで１００件です。

私の質問に向き合っていただきありがとうございます。
補足は私の説明不足です。
こちらこそ申し訳ないという気持ちです。
お言葉に甘えさせていただきます。
宜しくお願いいたします。m(._.)m

回答No.1

ham_kamo

えっとVBAは作ればできそうですが、その前にいろいろ補足をお願いします。

このサイトでは、書き込んだものがそのまま表示されず、連続した半角スペースは１つのスペースにまとめられます。このような例をしめすときは、位置関係を明確にするために全角スペースを使った方がよいです。

さて、質問文の２つの表は、どれも項目が１つのスペースで区切られていますが、最後の金額は貸方か借方かわかりません。全部借方に見えますが、貸方の方に入力したつもりの数字もあるのでしょうか。

> 1.[sheet1]と[sheet2]の日付と金額を照合させて2つの条件が一致するデータを探す

とありますが、これは貸方どうしが両シートで一致、または借方どうしが両シートで一致すれば色をつける、ということでよろしいでしょうか。それとも借方だけ、あるいは貸方だけ比較すればいいのでしょうか。

それから、
> 3.日付と金額が一致している行が複数あるなら対象データ(行)を薄いピンクに塗りつぶす

というのは、「同じ日付で同じ金額」の行が複数あるなら、ということでしょうか。それとも単純に日付と金額が一致している行が２行以上あれば、全部薄いピンクに塗りつぶす、ということでしょうか。

> 4.一致しないデータを[sheet3]に日付と金額のみ貼り付ける

このデータは、Sheet1とSheet2の両方から、色のついてない行の日付と金額をSheet3に全て転記する、ということでしょうか。
その際、金額は借方と貸方にわけるのでしょうか。
つまり、Sheet3は、以下みたいなイメージなのでしょうか。

Ａ　　Ｂ　　Ｃ
日付 借方　貸方
2/1　2,000
2/1　　　　5,000

以上、補足をお願いします。

補足

早速回答をしていただきありがとうございます。
書き込んだ「表」が明確に表示させずにすみませんでした。

>さて、質問文の２つの表は、どれも項目が１つのスペースで区切られていますが、最後の金額は貸方か借方かわかりません。
>全部借方に見えますが、貸方の方に入力したつもりの数字もあるのでしょうか。

実際に使用しているデータには借方、貸方ともに金額が入っています。
今回の例には金額は入っていません。

>> 1.[sheet1]と[sheet2]の日付と金額を照合させて2つの条件が一致するデータを探す
>とありますが、これは貸方どうしが両シートで一致、または借方どうしが両シートで一致すれば色をつける、
>ということでよろしいでしょうか。それとも借方だけ、あるいは貸方だけ比較すればいいのでしょうか。

はい、その通りです。
日付と借方金額・日付と貸方金額が両シートで一致したら色をつけたいんです。

>> 3.日付と金額が一致している行が複数あるなら対象データ(行)を薄いピンクに塗りつぶす
>というのは、「同じ日付で同じ金額」の行が複数あるなら、ということでしょうか。
>それとも単純に日付と金額が一致している行が２行以上あれば、全部薄いピンクに塗りつぶす、ということでしょうか。

両シートで借方金額と日付が一致するもの、貸方金額と日付が一致するものが
借方、貸方それぞれ２行以上あれば塗りつぶしたいです。

>>4.一致しないデータを[sheet3]に日付と金額のみ貼り付ける
>このデータは、Sheet1とSheet2の両方から、色のついてない行の日付と金額をSheet3に全て転記する、ということでしょうか。
>その際、金額は借方と貸方にわけるのでしょうか。
>つまり、Sheet3は、以下みたいなイメージなのでしょうか。

はい、その通りです。一致しないデータをすべて借方、貸方に分けて表示したいのです。
書いていただいた表イメージをsheet3へ転記するようにしたいのです。

こんなに複雑なことがVBAで可能でしょうか。。。
何卒、お願いします。