マクロの書き方2
tom04さま、本当にありがとうございました。めぐみです。
すみません、先程の質問の続きになってしまいます。
Sheet2にのA列は時々同じ番号が2つ,3つあることがあります。
Sheet2に同じ番号があった場合は、Sheet1のダブっている番号の横のB列セルを黒くしたいです。
そのセルの中はSheet2の情報が反映されてもされなくてもどちらでもかまいません。
ただ、Sheet2のA列に同じ番号があった場合にSheet1のダブっている番号の横のB列セルを黒くなるという機能が追加されていればそれで良いです。
例えば下記のように1行目と4行目に同じ番号が存在していたら、Sheet1のA列の702725の横のB列のセルが黒くなっていたらいいです。
■Sheet2
A列 B列 C列
702725 X
702872 X
770074 0
702725 0
770223 Z
770474 0
770242 X
770264 X
770330 0
770347 X
770422 X
770468 0
770523 X
770577 0
770627 X
770672 X
770677 0
770720 X
770723 X
770725 Z
770727 X
恐れ入りますが何卒よろしくお願いいたします。
No.2です!
前回は余計なお世話を焼いてしまったようですね!
昨日の方法でSheet2・A列にSheet1のデータが複数あれば単純にB列を黒くすれば良いだけですよね!
(もちろんSheet1のB列セル内データはSheet2の最終データになってしまいます)
ただ、黒いセルの場合はデータは関係なくSheet2に重複していることが判れば良い!という解釈での方法です。
昨日のコードに少しだけ手を加えます。
Sub test5()
Dim i, j As Long
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
Application.ScreenUpdating = False
For i = 1 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
If ws1.Cells(i, 1) = ws2.Cells(j, 1) Then
If ws2.Cells(j, 2) <> "" Then
ws1.Cells(i, 2) = ws2.Cells(j, 2)
Else
With ws1.Cells(i, 2)
.Value = ws2.Cells(j, 3)
With .Font
.ColorIndex = 3
.Bold = True
End With
End With
End If
End If
Next j
If WorksheetFunction.CountIf(ws2.Columns(1), ws1.Cells(i, 1)) > 1 Then
ws1.Cells(i, 2).Interior.ColorIndex = 1
End If
Next i
Application.ScreenUpdating = True
End Sub
こんな感じがご希望だったのでしょうかね?
今回も的外れならごめんなさいね。m(_ _)m
こんばんは!
>Sheet2にのA列は時々同じ番号が2つ,3つあることがあります。
とあります。
前回 → http://okwave.jp/qa/q7099523.html
のコードでは最後のデータしか表示されませんので、
一つの案ですが・・・
Sheet2のA列にいくつ重複データがあっても構わないので、Sheet1のB列・C列・・・列にSheet2のデータを表示してはどうでしょうか?
今回もSheet2のB・C列のどちらかにデータが入っているとします。
C列データ表示の場合は赤文字・太字にしてみました。
Sub test3()
Dim i, j As Long
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
Application.ScreenUpdating = False
For i = 1 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
If ws1.Cells(i, 1) = ws2.Cells(j, 1) Then
If ws2.Cells(j, 2) <> "" Then
ws1.Cells(i, Columns.Count).End(xlToLeft).Offset(, 1) = ws2.Cells(j, 2)
Else
With ws1.Cells(i, Columns.Count).End(xlToLeft).Offset(, 1)
.Value = ws2.Cells(j, 3)
With .Font
.ColorIndex = 3
.Bold = True
End With
End With
End If
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
こんな感じではどうでしょうか?m(_ _)m
※ 当方をご指名のような感じの質問になっていますが、他の方はなかなか回答しづらいと思います。
おっさんをご指名していただくのはうれしいのですが・・・
当方の方法がベストではありませんので、個人名を出さない方が
他の方々からの投稿があって、もっと良い方法が見つかるかもしれません。
お礼
めぐみです。 ありがとうございます、完璧でした。 非常に使いやすいです。 丁寧に、そして迅速にお応え下さり本当にありがとうございました。 後ほどベストアンサーとさせて頂きますね。 本当にありがとうございました。