【最大10000ポイント】当たる!!質問投稿キャンペーン!

派遣切り後、事務職の就職がようやく見つかりました。
仕事の効率を少しでも上げて、より多くの業務処理をしたいので下記のマクロを作成したいと考えています。
1ヶ月前に書籍を購入して独自でできるか試したのですがダイレクトな情報が見つからず、基礎の部分だけはできたところです。
恐縮なのですがもし、できる方がいましたらぜひ教えて頂けませんでしょうか【黄色付け機能の所を】。

赤色付け機能(既に有り):
下記のようにSheet1のA列の数字を1つずつ検索して、sheet2にその数字があれば、sheet2のそのセル赤くする。
Sub 赤色付け()

Set WS1 = Worksheets("Sheet1")
Set WS2 = Worksheets("Sheet2")

Dim RowPos As Integer
Dim i As Integer

For RowPos = 1 To 200

If WorksheetFunction.CountIf(Range(WS2.Cells(1, 1), WS2.Cells(200, 1)), WS1.Cells(RowPos, 1)) > 0 Then
i = WorksheetFunction.Match(WS1.Cells(RowPos, 1), Range(WS2.Cells(1, 1), WS2.Cells(200, 1)), 0)
WS2.Cells(i, 1).Interior.ColorIndex = 3
End If

Next

End Sub
【黄色付け機能:】
sheet1羅列を検索してsheet2に無い場合、逆にsheet1のその数字(検索してなかった数字)を黄色にもする ということは可能でしょうか。
下の場合、sheet1の123456と789123と456789が黄色になります。
そして、sheet2の123456と789123と456789以外が赤色になります。
●sheet1のA列に下記のような数字が羅列(200行程)しています。
238062
238075
238096
238210
91518
238230
123456
789123
456789
●sheet2のA列に下記のような数字が羅列しています。
91518
238062
238075
238096
238210
238230

このQ&Aに関連する最新のQ&A

A 回答 (1件)

Set WS1 = Worksheets("Sheet1")


Set WS2 = Worksheets("Sheet2")

Dim RowPos As Integer
Dim i As Integer

For RowPos = 1 To 200

If WorksheetFunction.CountIf(Range(WS2.Cells(1, 1), WS2.Cells(200, 1)), WS1.Cells(RowPos, 1)) > 0 Then
i = WorksheetFunction.Match(WS1.Cells(RowPos, 1), Range(WS2.Cells(1, 1), WS2.Cells(200, 1)), 0)
WS2.Cells(i, 1).Interior.ColorIndex = 3
ELSE '追加
WS1.Cells(RowPos, 1).Interior.ColorIndex = 6 '追加
End If

Next

一例です。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


人気Q&Aランキング