Excelマクロでセルの比較

質問

Excelマクロでセルの比較
まだマクロ初心者なので、詳しいことがわからなくて困っております。

例）●前提として何行目まであるかは変化します
　　　　（A列）（B列）
（1行目）　35　　35
（2行目）　26　　26
（3行目）　13　　13
（ｎ行目） 12　　12 ※n=最終行

【やりたいこと】
このようにシートに入力されていたとして、
「A1=B1？」⇒「A2=B2?」⇒「A3=B3?」⇒「An=Bn?」と比較を進めていき不一致の有無を出す。
もし不一致がなければ、そのまま通過しその次のマクロを実行していく。
不一致があった場合には、不一致の行を別ファイルに出力してファイル保存し、ファイルを閉じる。
マクロを実行している元のファイルは、保存せずにファイルを閉じる）
行の長さが変化するため、その変化にも対応した処理を実行したいと思っております。

本やサイトで調べてみたのですが、基礎知識がないためうまく処理をさせるマクロを作ることが出来ませんでした。
このようなマクロが可能なのかもわかりませんが、出来ましたらこのマクロを教えていただけますでしょうか。
宜しくお願いいたします。

回答No.5

Wendy02 · ベストアンサー

ご説明に応じて、こんな感じにしてみました。今は、日付ファイルにしていますから、
Excel 2003以下ですと、
　　Test100630.xls
というファイル名になります。日付ですから、同じファイル名になると、上書き保存するか聞いてきます。
自動的に終わってしまいますので、保存する必要がある時は、マクロの前に保存しておいてください。
このマクロの真価を現すのは、1対1で調べるコードと比較すると、1万行以上の場合に、速さがかなり違ってくるはずです。

'//
Sub PikcUpTest1()
　Dim acSh As Worksheet
　Dim wb As Workbook
　Dim flg As Boolean
　Dim i As Long, k As Long
　Dim sFileName As String
　'保存ファイル名(セルからでも可能ですし、InputBoxを使っても可能です）
　sFileName = "Test" & Format(Date, "yymmdd")
　Set acSh = ActiveSheet
　With acSh
　　Application.ScreenUpdating = False
　　k = .Cells(Rows.Count, 1).End(xlUp).Row
　　For i = 1 To k
　　　If .Cells(i, 1).Value <> .Cells(i, 2).Value Then
　　　　.Cells(i, 3).Value = 1
　　　　flg = True
　　　End If
　　Next i
　　If flg Then
　　　.Range("A1").Resize(k, 3).AutoFilter _
　　　field:=3, _
　　　Criteria1:="1"
　　Else
　　　MsgBox "検出できませんでした。", vbInformation
　　End If
　End With
　Application.ScreenUpdating = True
　With Workbooks.Add
　　acSh.AutoFilter.Range.Resize(, 2).Copy .Worksheets(1).Range("A1")
　　If acSh.Range("C1").Value = "" Then
　　　.Worksheets(1).Rows(1).Delete
　　End If
　　acSh.Columns(3).ClearContents 'C列を削除
　　acSh.Range("A1").AutoFilter
　　.SaveAs sFileName '保存
　　.Close False 'ファイルを閉じる
　End With
　ThisWorkbook.Saved = True
　Application.Quit　'Excel終了(ただし、Excel2007は閉じられないはずです。）
End Sub

お礼

お礼が遅くなりまして申し訳ありません。
具体的に追加質問をして頂いた為、
今回処理したいことの方向に合致していたので、
無事難題を乗り越えることが出来ました。
ありがとうございました。

回答No.4

Wendy02

どうするか、私には良く分かりません。もう少し正確に書いてくださいませんか？

>「A1=B1？」⇒「A2=B2?」⇒「A3=B3?」⇒「An=Bn?」と比較を進めていき不一致の有無を出す。
>不一致があった場合には、不一致の行を別ファイルに出力してファイル保存し、ファイルを閉じる。
不一致の行をひとつずつ別々のファイルに出力して保存していくのですか？
つまり、10違う行があれば、10ファイルが出来るということです。
それとも、まとめたものをひとつのファイルに出力するのですか？
ファイル名は予め決められているものなのですか？それとも、任意なのですか？
元のファイルは、保存せずにファイルを閉じる、ということは、Excel自体を終了してしまうという意味ですか？

解釈の取りようによっては、かなり違ってきてしまいす。

補足

確かに説明が不明確ですね。

・「不一致の行をひとつずつ別々のファイルに出力して保存していくのですか？
つまり、10違う行があれば、10ファイルが出来るということです。
それとも、まとめたものをひとつのファイルに出力するのですか？」
⇒まとめて一つのファイルに出力出来ればと思っております。

・「ファイル名は予め決められているものなのですか？それとも、任意なのですか？」
⇒ファイル名は任意で設定する方向で考えております。

・「元のファイルは、保存せずにファイルを閉じる、ということは、Excel自体を終了してしまうという意味ですか？」
⇒Excel自体を終了するイメージです

・「解釈の取りようによっては、かなり違ってきてしまいす。」
⇒おっしゃるとおり、解釈の取り方が複数考えられましたね。すみません。
　上記の補足でわかりますでしょうか。
　宜しくお願いいたします。

回答No.3

imogasi

>行の長さが変化するため、その変化にも対応した処理を実行したいと思っております
あるシートの最下行を見つけるコード
d=Range("A65536").End(xlUp).Row
第１行からなら
For i=1 To d
If Cells(i,"A")=Cells(i,"B") Then
等しい場合の処理
Else
等しくないときの処理
End If
Next i
これらは常識。
＞マクロを実行している元のファイルは、保存せずにファイルを閉じる）
＞別ファイルに出力して
＞別ファイル保存し
のコードの方が初心者には難しいのでは。
全てＧｏｏｇｌｅででも照会すれば、記事が出てくる。自分で調べること。
検索語　エクセル　ＶＢＡ　最終行　取得
http://www.happy2-island.com/excelsmile/smile03/capter00702.shtml
のように。
「エクセル　ＶＢＡ　別ファイル　出力」
初心者らしいが、エクセルの操作を勉強して、操作によるマクロの記録が使えないか、いつも頭に置くこと。

お礼

お礼が遅くなりまして申し訳ありません。
自分なりに本を見たりネットで検索してみたのですが、
まだ自分の知識の整理がついていないため、
完全にやりたい事の例がないと出来ないレベルのようです。
知識を丸覚えするのではなく、基本を知った上で、
あとはその組み合わせであることがわかりました。
今回のアドバイスにより、そういう発想が今の自分にはないことがわかりましたが、
その発想を今後に生かしていければと思います。
ありがとうございました。

回答No.2

kmetu

訂正です　不一致でしたね

If Range("A" & i).Value = Range("B" & i).Value Then

↓

If Range("A" & i).Value <> Range("B" & i).Value Then

お礼

お礼が遅くなり申し訳ありません。
大変参考になりました。
教えて頂いた方法が他にも応用出来そうなものでしたので、
今後の引き出しになりました。
ありがとうございました。

回答No.1

kmetu

Sub test()

Dim Newbook As Workbook

For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
If Range("A" & i).Value = Range("B" & i).Value Then
Range("A" & i & ":" & "B" & i).Copy
Set Newbook = Workbooks.Add
Newbook.Sheets(1).Range("A1").PasteSpecial
Newbook.SaveAs Filename:="d:\NewBook" & i
End If
Next

End Sub

細かいところはご自身でなおしてください。