[[20070530200106]]　『変更検索』（000）　ページの最後に飛ぶ

『変更検索』（000）初心者

 お世話になります。こんな事って出来るのでしょうか・・

 横はA～AVまで縦は30000万位のデータがあります。

 ブックが二つあります。二つの相違部分を検索して

 違いがある部分を、色付けなどして二つの相違を一発で検索できる方法ってあるのでしょうか？？

 また、違う部分だけを後で引き出したいので、AW列に（相違）などと表示がほしいのですが？

 ブック名とシート名が何でも対応出来れば便利なのですが？

 現在は地道な作業をしていて大変で・・・よろしくお願いします。。

 （000)初心者

 [違い]の詳しい定義をしてください。
 (seiya)

すみません。違いの定義はないのです。

何処が違うのかを検索したいのです。

ブック１

	A	Ｂ	AW
1	koko	第１	相違
2	sasa	第２	
3	mimi	第３	相違

ブック２

	A	Ｂ	AW
1	koko	第２	相違
2	sasa	第２	
3	hana	第３	相違

上記のようにブック１のＢ１は第1なのにブック２のＢ１は第２なので・・相違

ブック１のＢ3はmimiなのにブック２のＢ3はhanaなので・・相違

と言う具合に両方が一致していればＡＷにはなにも無いのですが・・

（000)初心者

 「A&B列の違い」ですね？

 単に「違い」と言っても、いろいろな解釈が成り立ってしまう。
 1) セル単位（同一セル）の比較
 2) 行/列単位の比較（同一行/列単位と言う意味)
 3) 片方にあって、もう一方に無い

 等、さまざまに定義されてしまうのですよ。

 セル単位の比較ですかね？
 (seiya)

説明不足ですみません。

Ａ１：ＡＶ30000の範囲のセル単位の比較です。

（000）

 Book1.xls の Sheets(1) (左端にあるシート) と
 Book2.xls の Sheets(1) (左端にあるシート）の A ～ AV 列 をセル単位で比較

 Boo1.xls, Book2.xls ともに開かれている

 ということで

 Sub test()
 Dim a, b, aw(), bw(), i As Long, ii As Integer, x As Long, flg As Boolean
 Dim ws1 As worksheet, ws2 As Worksheet, txt As String
 Set ws1 = Workbooks("Book1.xls").Sheets(1)
 Set ws2 = Workbooks("Book2.xls").Sheets(1)
 x = WorksheetFunction.Max(ws1.UsedRange.SpecialCells(11).Row, ws2.UsedRange.SpecialCells(11).Row)
 a = ws1.Range("a1").Resize(x, 48).Value
 b = ws2.Range("a1").Resize(x, 48).Value
 ReDim aw(1 To x, 1 To 1), bw(1 To x, 1 To 1)
 For i = 1 To UBound(a,1)
      flg = False
      For ii = 1 To UBound(a,2)
           If a(i,ii) <> b(i,ii) Then
                If Not flg Then aw(i,1) = "相違" : bw(i,1) = "相違" : flg = True
                txt = txt & Cells(i,ii).Address(0,0) & ","
                If Len(txt) > 245 Then
                     ws1.Range(Left(txt, Len(txt) - 1)).Interior.ColorIndex = 3
                     ws2.Range(Left(txt, Len(txt) - 1)).Interior.ColorIndex = 3
                     txt = ""
                End If
           End If
 Next ii, i
 If Len(txt) Then
      ws1.Range(Left(txt, Len(txt) - 1)).Interior.ColorIndex = 3
      ws2.Range(Left(txt, Len(txt) - 1)).Interior.ColorIndex = 3
 End If
 ws1.Range("aw1").Resize(x).Value = aw
 ws2.Range("aw1").Resize(x).Value = bw
 End Sub
 (seiya)

ありがとうございます。完璧です。。

もう一つお願いしてもよろしいでしょうか？

相違部分を塗りつぶしか文字に色などを付けられると最高なのですが？何度も申し訳ございません。。

（000)

 コード変更しましたので確認してください。
 (seiya)

ありがとうございました。完璧です・・

１つ教えて下さい。上記のマクロで色を塗りつぶす箇所はどこですか？？

違う色に変更する場合に変えたいので。。

また、色の変更って番号？それとも英語？

（000)

 色の変更箇所：
 Interior.ColorIndex = 3 の部分　3 = 赤

 Sub ColorSampleByColorIndex()
 Dim i As Byte
 Cells(1,1).Resize(,2).Value = [{"色","ColorIndex"}]
 For i = 1 To 56
      Cells(i + 1,"a").Interior.ColorIndex = i
      Cells(i + 1,"b").Value = i
 Next
 End Sub
 (seiya)

コメント返信：

[ 一覧(最新更新順) ]

[[20070530200106]] 『変更検索』（000） ページの最後に飛ぶ

[[20070530200106]]　『変更検索』（000）　ページの最後に飛ぶ