過去ログ

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　Ｐａｇｅ     598
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
　　　通常モードに戻る　　┃　　ＩＮＤＥＸ　　┃　　≪前へ　　│　　次へ≫　　　
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
　▼２つの表の比較について  ぷるぷる 03/1/22(水) 15:19
　　　┗Re:２つの表の比較について  ぴかる 03/1/22(水) 16:01
　　　　　　┗Re:２つの表の比較について  ぷるぷる 03/1/22(水) 19:47
　　　　　　　　　┣Re:２つの表の比較について  Jaka 03/1/23(木) 9:58
　　　　　　　　　┃　　┗訂正。  Jaka 03/1/23(木) 10:24
　　　　　　　　　┗条件付書式はＮＧ！  ぴかる 03/1/23(木) 12:39
　　　　　　　　　　　　┗本当にすみません（T_T）  ぷるぷる 03/1/23(木) 14:53
　　　　　　　　　　　　　　　┗Re:本当にすみません（T_T）  Jaka 03/1/23(木) 16:05
　　　　　　　　　　　　　　　　　　┗感謝します(o^-^o)  ぷるぷる 03/1/23(木) 16:37
　　　　　　　　　　　　　　　　　　　　　┗えっ！さっきので、本当に良いの？  Jaka 03/1/23(木) 16:56
　　　　　　　　　　　　　　　　　　　　　　　　┗またまたありがとうございます。  ぷるぷる 03/1/23(木) 18:57

　───────────────────────────────────────
　■題名 ： ２つの表の比較について
　■名前 ： ぷるぷる
　■日付 ： 03/1/22(水) 15:19
　-------------------------------------------------------------------------
   
みなさん、こんにちわ(*'-'*)

２つの表の比較について教えてください。



sheet1とsheet2に下のようなデータが入っているとします。



sheet1　　　　　　　　　　　　

番号　枝番　　名前　数量　　　

1　　　01　　りんご　1

1　　　02　　みかん　2

2　　　01　　りんご　2

3　　　01　　バナナ　3　



sheet2

番号　枝番　　名前　数量

1　　　01　　みかん　3

1　　　02　　みかん　2

2　　　01　　りんご　2

2　　　02　　りんご　1

3　　　01　　バナナ　3





この２つのシートを比較して、番号と枝番が一致するもので名前と数量が

変わっているところと、新規に追加された内容のsheet2のセルに網掛けを

したいのですがどうしたらよいのでしょうか？

あと、sheet1とsheet2は常に名前が変わりますが、sheet1のあとにsheet2

という並びはかわりません。なので、sheet2を選んでマクロを実行すると

自動で前のsheet1と比較させたいのですが・・・

どうか、よろしくお願いします<(_ _)>


　───────────────────────────────────────
　■題名 ： Re:２つの表の比較について
　■名前 ： ぴかる
　■日付 ： 03/1/22(水) 16:01
　-------------------------------------------------------------------------
   
ぷるぷるさん、こんにちは。



状況と合っているがどうか分かりませんが、マクロではなく一般機能の条件付き書式を

使ってみるのはどうでしょうか？。数式をsheet1の内容＝sheet2の内容として書式を

設定してやればＯＫの様な気がします。的外れだったら、ゴメンナサイです。


　───────────────────────────────────────
　■題名 ： Re:２つの表の比較について
　■名前 ： ぷるぷる
　■日付 ： 03/1/22(水) 19:47
　-------------------------------------------------------------------------
   
解答ありがとうございます。

条件付書式も考えましたが、Sheet名が2つとも常に変わるので

数式でどのようにしてよいかわかりませんでした。

マクロでも条件付書式でも何でもよいので良い方法が

ありましたらよろしくお願いします。


　───────────────────────────────────────
　■題名 ： Re:２つの表の比較について
　■名前 ： Jaka
　■日付 ： 03/1/23(木) 9:58
　-------------------------------------------------------------------------
   
こんにちは。

いま一歩、処理内容が解ってませんが．．．。



Sub popo()

　　Sh2EndRow = Cells(Rows.Count, "A").End(xlUp).Row

　　Sh1EndRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row

　　For i = 2 To Sh2EndRow

　　　　Set CCel = Sheets("Sheet1").Range("A1" & ":A" & Sh1EndRow).Find(Range("A" & i).Value, _

　　　　　　After:=Sheets("Sheet1").Range("A1"), LookAt:=xlWhole, MatchCase:=True)

　　　　If Not CCel Is Nothing Then

　　　　　 SaveAd = CCel.Address

　　　　　 Do

　　　　　　　If Cells(i, 2).Value = Sheets("Sheet1").Range(CCel.Address).Offset(, 1).Value Then

　　　　　　　　 If Cells(i, 3).Value <> Sheets("Sheet1").Range(CCel.Address).Offset(, 2).Value Or _

　　　　　　　　　　Cells(i, 4).Value <> Sheets("Sheet1").Range(CCel.Address).Offset(, 3).Value Then

　　　　　　　　　　Range("A" & i).Resize(, 4).Interior.Pattern = xlGray16

　　　　　　　　 End If

　　　　　　　End If

　　　　　　　Set CCel = Sheets("Sheet1").Range("A1" & ":A" & Sh1EndRow).FindNext(CCel)

　　　　　 Loop Until SaveAd = CCel.Address

　　　　　 Set CCel = Nothing

　　　　End If

　　Next

　　Set CCel = Nothing

End Sub


　───────────────────────────────────────
　■題名 ： 訂正。
　■名前 ： Jaka
　■日付 ： 03/1/23(木) 10:24
　-------------------------------------------------------------------------
   
>sheet1とsheet2は常に名前が変わりますが、sheet1のあとにsheet2

>という並びはかわりません。



すみません。見落してました。



Sub popo()

　　Dim ShNo As Long, Sh1Name As String, Sh1EndRow As Long, Sh2EndRow As Long

　　Dim CCel As Variant, SaveAd As String, i As Long

　　ShNo = ActiveSheet.Index

　　If ShNo > 1 Then

　　　 Sh1Name = Sheets(ShNo - 1).Name

　　Else

　　　 End

　　End If

　　Sh2EndRow = Cells(Rows.Count, "A").End(xlUp).Row

　　Sh1EndRow = Sheets(Sh1Name).Cells(Rows.Count, "A").End(xlUp).Row

　　For i = 2 To Sh2EndRow

　　　　Set CCel = Sheets(Sh1Name).Range("A1" & ":A" & Sh1EndRow).Find(Range("A" & i).Value, _

　　　　　　After:=Sheets(Sh1Name).Range("A1"), LookAt:=xlWhole, MatchCase:=True)

　　　　If Not CCel Is Nothing Then

　　　　　 SaveAd = CCel.Address

　　　　　 Do

　　　　　　　If Cells(i, 2).Value = Sheets(Sh1Name).Range(CCel.Address).Offset(, 1).Value Then

　　　　　　　　 If Cells(i, 3).Value <> Sheets(Sh1Name).Range(CCel.Address).Offset(, 2).Value Or _

　　　　　　　　　　Cells(i, 4).Value <> Sheets(Sh1Name).Range(CCel.Address).Offset(, 3).Value Then

　　　　　　　　　　Range("A" & i).Resize(, 4).Interior.Pattern = xlGray16

　　　　　　　　 End If

　　　　　　　End If

　　　　　　　Set CCel = Sheets(Sh1Name).Range("A1" & ":A" & Sh1EndRow).FindNext(CCel)

　　　　　 Loop Until SaveAd = CCel.Address

　　　　　 Set CCel = Nothing

　　　　End If

　　Next

End Sub


　───────────────────────────────────────
　■題名 ： 条件付書式はＮＧ！
　■名前 ： ぴかる
　■日付 ： 03/1/23(木) 12:39
　-------------------------------------------------------------------------
   
ぷるぷるさん、こんにちは。



ゴメンナサイ。条件付書式はＮＧでした。数式は、同シート内でしか無理の様です。

適当にお答えしたわたしは、ダメですね。以後、気を付けますっ。


　───────────────────────────────────────
　■題名 ： 本当にすみません（T_T）
　■名前 ： ぷるぷる
　■日付 ： 03/1/23(木) 14:53
　-------------------------------------------------------------------------
   
ＪＡＫＡさんぴかるさんありがとうございます。

さっそく、試してみました。うまくいきました。

それでＪＡＫＡさんのを元にもうちょっと改善しようとしたのですが

初心者の私にはどうしても無理だったので、またまたよろしくお願いします。

ＪＡＫＡさんのマクロを実行すると、名前と数量が変更の場合、行全体が

網掛けになってしまうので、これを変更のあったセルだけに網掛けしたいのですが・・・

あと、sheet1にはなくてsheet2に新たに加わったデータの行にも網掛けするには

どうしたらよいのでしょうか？

せっかく教えていただいたのに、欲が出ちゃいました。

本当にすみません。


　───────────────────────────────────────
　■題名 ： Re:本当にすみません（T_T）
　■名前 ： Jaka
　■日付 ： 03/1/23(木) 16:05
　-------------------------------------------------------------------------
   
>sheet1にはなくてsheet2に新たに加わったデータの行にも網掛けする

これについては、私の書いたコードを基本ベースとするとロジックというかアルゴリズムが今一思いつかないので、多分全くの作りなおしか、ループ処理の付け足しと言う事に成りそうなんで．．．。

保留。

他のはこんな感じ？



Sub popo()

　　Dim ShNo As Long, Sh1name As String, Sh1EndRow As Long, Sh2EndRow As Long

　　Dim CCel As Variant, SaveAd As String, i As Long

　　ShNo = ActiveSheet.Index

　　If ShNo > 1 Then

　　　 Sh1name = Sheets(ShNo - 1).Name

　　Else

　　　 End

　　End If

　　Sh2EndRow = Cells(Rows.Count, "A").End(xlUp).Row

　　Sh1EndRow = Sheets(Sh1name).Cells(Rows.Count, "A").End(xlUp).Row

　　For i = 2 To Sh2EndRow

　　　　Set CCel = Sheets(Sh1name).Range("A1" & ":A" & Sh1EndRow).Find(Range("A" & i).Value, _

　　　　　　After:=Sheets(Sh1name).Range("A1"), LookAt:=xlWhole, MatchCase:=True)

　　　　If Not CCel Is Nothing Then

　　　　　 SaveAd = CCel.Address

　　　　　 Do

　　　　　　　If Cells(i, 2).Value = Sheets(Sh1name).Range(CCel.Address).Offset(, 1).Value Then

　　　　　　　　 If Cells(i, 3).Value <> Sheets(Sh1name).Range(CCel.Address).Offset(, 2).Value Then

　　　　　　　　　　Cells(i, 3).Interior.Pattern = xlGray16

　　　　　　　　 End If

　　　　　　　　 If Cells(i, 4).Value <> Sheets(Sh1name).Range(CCel.Address).Offset(, 3).Value Then

　　　　　　　　　　Cells(i, 4).Interior.Pattern = xlGray16

　　　　　　　　 End If

　　　　　　　End If

　　　　　　　Set CCel = Sheets(Sh1name).Range("A1" & ":A" & Sh1EndRow).FindNext(CCel)

　　　　　 Loop Until SaveAd = CCel.Address

　　　　　 Set CCel = Nothing

　　　　End If

　　Next

　　Set CCel = Nothing

End Sub



>欲が出ちゃいました。

欲かきすぎて、止め時を見失い、全部飲まれて泣かない様にしましょう。

と、いつも自分に言い聞かせているんだけど、すぱっと止められないんだよね！


　───────────────────────────────────────
　■題名 ： 感謝します(o^-^o)
　■名前 ： ぷるぷる
　■日付 ： 03/1/23(木) 16:37
　-------------------------------------------------------------------------
   
わがままにつきあっていただき、ありがとうございました。

今まで、印刷してから間違い探し状態だったので、

寝不足のときなどは本当に苦労しましたが

これで、憂鬱な作業が楽になりました。

本当に本当にありがとうございました。


　───────────────────────────────────────
　■題名 ： えっ！さっきので、本当に良いの？
　■名前 ： Jaka
　■日付 ： 03/1/23(木) 16:56
　-------------------------------------------------------------------------
   
一応、取り急ぎパターンでIV列を使用して、新規の物の行に2、そうでないものに1と書き込みましたんで、条件書式を使ってパターンを変えて下さい。（急場しのぎのごまかしですが．．．。）



Sub Shirobon()

　　Dim ShNo As Long, Sh1name As String, Sh1EndRow As Long, Sh2EndRow As Long

　　Dim CCel As Variant, SaveAd As String, i As Long

　　ShNo = ActiveSheet.Index

　　If ShNo > 1 Then

　　　 Sh1name = Sheets(ShNo - 1).Name

　　Else

　　　 End

　　End If

　　Columns("IV").ClearContents

　　Sh2EndRow = Cells(Rows.Count, "A").End(xlUp).Row

　　Sh1EndRow = Sheets(Sh1name).Cells(Rows.Count, "A").End(xlUp).Row

　　For i = 2 To Sh2EndRow

　　　　Set CCel = Sheets(Sh1name).Range("A1" & ":A" & Sh1EndRow).Find(Range("A" & i).Value, _

　　　　　　After:=Sheets(Sh1name).Range("A1"), LookAt:=xlWhole, MatchCase:=True)

　　　　If Not CCel Is Nothing Then

　　　　　 SaveAd = CCel.Address

　　　　　 Do

　　　　　　　If Cells(i, 2).Value = Sheets(Sh1name).Range(CCel.Address).Offset(, 1).Value Then

　　　　　　　　 If Cells(i, 3).Value <> Sheets(Sh1name).Range(CCel.Address).Offset(, 2).Value Then

　　　　　　　　　　Cells(i, 3).Interior.Pattern = xlGray16

　　　　　　　　 End If

　　　　　　　　 If Cells(i, 4).Value <> Sheets(Sh1name).Range(CCel.Address).Offset(, 3).Value Then

　　　　　　　　　　Cells(i, 4).Interior.Pattern = xlGray16

　　　　　　　　 End If

　　　　　　　　 Range("IV" & i).Value = 1

　　　　　　　ElseIf Range("IV" & i).Value <> 1 Then

　　　　　　　　 Range("IV" & i).Value = 2

　　　　　　　End If

　　　　　　　Set CCel = Sheets(Sh1name).Range("A1" & ":A" & Sh1EndRow).FindNext(CCel)

　　　　　 Loop Until SaveAd = CCel.Address

　　　　　 Set CCel = Nothing

　　　　ElseIf Range("IV" & i).Value <> 1 Then

　　　　　 Range("IV" & i).Value = 2

　　　　End If

　　Next

　　Set CCel = Nothing

End Sub


　───────────────────────────────────────
　■題名 ： またまたありがとうございます。
　■名前 ： ぷるぷる
　■日付 ： 03/1/23(木) 18:57
　-------------------------------------------------------------------------
   
またまたありがとうございます。

もう、なんてお礼を言っていいやら。

ヒントだけでは、そこから前に進めない私にとっては

丁寧に教えていただき本当に感謝しています。

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
　　　通常モードに戻る　　┃　　ＩＮＤＥＸ　　┃　　≪前へ　　│　　次へ≫　　　
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　Ｐａｇｅ     598