A、Bさんが記入した明細をクロスチェックするマクロ

質問

EXCEL2007でAさんが記入した売上と明細のBOOKがあります。また、Bさんが記入した売上と明細のBOOKがあります。同じフォルダーにあります。Aさんの明細とBさんの明細をマクロでクロスチェックをかけ、BさんのBOOKに”Sheet1"を新たに作成して、Aさんの明細を正解として、Bさんの明細と比較して違いをBさんの明細に色を付けて、新たに作成した”Sheet1"にも色を付けたいのですが、下記のマクロでは上手く動作しません。どうしたら動作するのでしょうか？ご教授願います。10月5日までには、上司に見せなくてはならないので、初めてですが、どうか宜しくお願い致します。

Option Explicit
Dim bookname1, bookname2 As String
Dim sheetname1, sheetname2, sheetname3 As String
Sub 管理部様式Aの比較()
Dim a, b, d, e
a = MsgBox("比較元のAを指定して下さい。", vbOKCancel)
If a = 2 Then
End
End If
b = Application.Dialogs(xlDialogOpen).Show
If b = False Then
End
End If
On Error Resume Next
bookname1 = ActiveWorkbook.Name
Workbooks(1).Activate
d = MsgBox("比較されるBを指定して下さい。", vbOKCancel)
If d = 2 Then
End
End If
e = Application.Dialogs(xlDialogOpen).Show
If e = False Then
End
End If
On Error Resume Next
bookname2 = ActiveWorkbook.Name
Dim ws1 As Object
Dim ws2 As Object
Set ws1 = Workbooks(bookname1).Worksheets("明細") 'シートの名前をストリングとして変数ws1に代入する
Set ws2 = Workbooks(bookname2).Worksheets("明細") 'シートの名前をストリングとして変数ws2に代入する
Dim i As Integer, j As Integer, k As Integer, l As Integer, x As Integer, y As Integer 'カントの変数
i = Application.InputBox(Prompt:="比較したいセルの列方向の一番初めの列数値を入力して下さい左上隅(A,B,・・・)の数値", Type:=1)
If i <> False Then
End If
j = Application.InputBox(Prompt:="比較したいセルの列方向の一番終りの列数値を入力して下さい右上隅(AA,AB,・・・)の数値", Type:=1)
If j <> False Then
End If
k = Application.InputBox(Prompt:="比較したいセルの行方向の一番初めの行数値を入力して下さい左上隅(1,2,・・・)の数値", Type:=1)
If k <> False Then
End If
l = Application.InputBox(Prompt:="比較したいセルの行方向の一番終りの行数値を入力して下さい左下隅(11,12,・・・)の数値", Type:=1)
If l <> False Then
End If
'==================================================================================
Sheets.Add After:=Worksheets(Sheets.Count), Count:=1 'sheet1を作成終了。
Dim ws3 As Object
Set ws3 = Workbooks(bookname2).Worksheets("Sheet1") 'bookname2のWorksheetsの名前をSheet1としている。
'==================================================================================
Dim c As Integer
c = 0
For y = k To l
For x = i To j
If ws1.Cells(y, x).Value = ws2.Cells(y, x).Value Then '値が一致した場合何もしない。
Else
ws2.Cells(y, x).Interior.ColorIndex = 3
'==================================================================================
Worksheets("Sheet1").Select
Range(y, x).Select
ws3.Cells(y, x).Interior.ColorIndex = 3
'==================================================================================
c = c + 1
End If '比較の判定終了。
Next x
Next y
'==================================================================================
If c > 0 Then
MsgBox "エラーが" & c & "セルあります。"
'Debug.Print c;
Else
MsgBox "終了" 'マクロの終了をWindows標記で示す
End If
ErrorHandler:
End Sub 'マクロの終了

回答No.1

haichicchi · ベストアンサー

>上手く動作しません。
では解りませんよ。どの部分でこんなエラーになる　とか、〇〇の値が
□□になってしまう　とか説明しないと。
回答者に全部デバッグしてもらおうというのは無理じゃないですか。

パッと見たところでは、BookやSheetのActiveの切り替えが意図したとおりに
なっているのかなぁ、とは気になりました。

お礼

ご回答どうもありがとうございます。別の手段で解決しました。ホントありがとうございます。今後ともよろしくお願い申しあげます。

補足

haichicchi様、何せ、初めて質問させて頂く者なのでルールも読みましたが、大変失礼しました。今後は、もっとマナーを守る様にしたいと考えておりますので、ご容赦願います。また、ご指摘どうも有難う御座いました。現象としては、BさんのBOOKには、新しいい”Sheet1"は出来ます。しかしBさんの明細には、色は付きますが、この新しいい”Sheet1"に色が付かないと言う現象がでております。私的には、ご指摘の様に以下の部分で==================================================================================
Worksheets("Sheet1").Select
Range(y, x).Select
ws3.Cells(y, x).Interior.ColorIndex = 3
'==================================================================================
>BookやSheetのActiveの切り替えが意図したとおりになっているのかなぁ、とは気になりました。
BookやSheetのActiveの切り替えが意図した通りになっていないと私も考えております。
〉回答者に全部デバッグしてもらおうというのは無理じゃないですか。
と言うつもりは全くありません。ただ、情報は、沢山あった方が良いと思い、こんなに書込みさせて頂きました。今後は、もっと完結に投稿させて頂きたく考えておりますので、お気持ちを害した事は心よりお詫び申し上げます。これに懲りずに、ご回答頂ける助かります。本当に申し訳なく宜しくお願い申し上げます。また、実際に動作するように、ご指摘の程宜しくお願い申し上げます。