下記のマクロを作成しました。
1.Sheet1のA列の数字を1つずつ検索して、sheet2にその数字があれば、sheet2のそのセル赤くする。
全部あればすべてのセルが赤くなり、無いところがあれば白いままというマクロ
2.sheet1羅列を検索してsheet2に無い場合、逆にsheet1のその数字(検索してなかった数字)を黄色にする。
困っていることは、何も数字の無いところが全部黄色になってしまいます。
sheet1の空白のところは処理せずにそのまま白くあって欲しいのですがどのようにすればいいでしょうか?
●sheet1のA列に下記のような数字が羅列(200行程)しています。
238062
238075
238096
238210
91518
238230
123456
789123
456789
●sheet2のA列に下記のような数字が羅列しています。
91518
238062
238075
238096
238210
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
ELSE
WS1.Cells(RowPos, 1).Interior.ColorIndex = 6
End If
Next
End Sub
No.1
- 回答日時:
>WS1.Cells(RowPos, 1).Interior.ColorIndex = 6
この黄色の塗りつぶしに、該当セルが空白でなかったら、という条件を付ければいいですね?
If ws1.Cells(RowPos, 1) <> "" Then
ws1.Cells(RowPos, 1).Interior.ColorIndex = 6
End If
それから、余計な一言。
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
Else
If ws1.Cells(RowPos, 1) <> "" Then
ws1.Cells(RowPos, 1).Interior.ColorIndex = 6
End If
Next
End Sub
No.2
- 回答日時:
これを試してみてください
Sub test()
Dim i, j
Dim WS1, WS2
Set WS1 = Worksheets("Sheet1")
Set WS2 = Worksheets("Sheet2")
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).Value = "" Then Exit For
If WS1.Cells(i, 1).Value = WS2.Cells(j, 1).Value Then
WS2.Cells(j, 1).Interior.ColorIndex = 3
Exit For
End If
Next j
If j > WS2.Cells(Rows.Count, 1).End(xlUp).Row Then
WS1.Cells(i, 1).Interior.ColorIndex = 6
End If
Next i
Set WS1 = Nothing
Set WS2 = Nothing
End Sub
参考まで
この回答への補足
ありがとうございます!
エラーが出ませんでした!!感謝です。
あと、Sheet2にダブりの番号はある可能性が有ります。
なので、ダブリがあった場合は
セルを緑色にするようにしたいのですが、どのようにすればいいでしょうか。。。
本当に質問ばかりで恐縮です・・・
まさにおっしゃるとおりです!
Sheet2にダブりの番号はある可能性が有ります。
なので、ダブリが会った場合は
セルを緑色にするようにしたいのですが、どのようにすればいいでしょうか。
No.3ベストアンサー
- 回答日時:
一例です。
Sub test01()
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim myRange1 As Range
Dim myRange2 As Range
Dim c1 As Range
Dim c2 As Range
Dim myCt As Long
Set Ws1 = Worksheets("Sheet1")
Set Ws2 = Worksheets("Sheet2")
Set myRange1 = Ws1.Range("A1", Ws1.Cells(Rows.Count, "A").End(xlUp))
Set myRange2 = Ws2.Range("A1", Ws2.Cells(Rows.Count, "A").End(xlUp))
For Each c1 In myRange1
myCt = 0
For Each c2 In myRange2
If c2.Value = c1.Value Then
If myCt = 0 Then
c2.Interior.ColorIndex = 3
Else
c2.Interior.ColorIndex = 10
End If
myCt = myCt + 1
End If
Next c2
If myCt = 0 Then c1.Interior.ColorIndex = 6
Next c1
Set Ws1 = Nothing
Set Ws2 = Nothing
Set myRange1 = Nothing
Set myRange2 = Nothing
End Sub
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) エクセルVBAで教えて頂きたいのですが? 2 2022/12/31 20:28
- Visual Basic(VBA) vbaのvlookup関数エラー原因を教えていただけないでしょうか。 3 2022/04/25 16:16
- Visual Basic(VBA) VBAコードが作動せず、どこに問題があるのか教えて下さい。 3 2023/06/13 13:20
- Visual Basic(VBA) ExcelVBAのマクロについて。 9 2022/05/04 14:50
- Visual Basic(VBA) 改行ごとに行を追加し、数量を分割 4 2023/07/11 16:39
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- Visual Basic(VBA) セルS2に入力した「月」と一致したB列の右隣へセルS110の値を転記する下記マクロを実行するとエラー 2 2022/12/06 17:32
- Visual Basic(VBA) Sheet「状況」から、分類の年齢別カウント数をSheet「D表」へ転記する下記マクロを作っています 7 2022/12/14 17:57
- Visual Basic(VBA) Excelで下記のようにマクロを作ったところ、一回目は実行できたのですが、二回目以降「実行時エラー1 1 2022/03/25 08:08
- Excel(エクセル) 指定文字列が該当するA列をアクティブセルにするには 3 2022/08/17 13:18
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセル マクロ オートフィ...
-
結合されたセルをプルダウンの...
-
エクセルで特定の文字列が入っ...
-
[EXCEL]ボタン押す→時刻が表に...
-
【Excel関数】UNIQUE関数で"0"...
-
罫線の斜線を自動で引くマクロ
-
AのセルとB行を比較して、一致...
-
エクセルマクロ オートSUM(合...
-
VBAで色の付いているセルの行削除
-
【VBA】「同じ文字を含むセ...
-
電話番号の入力方式が違うデー...
-
"/"でセル内の文字を縦に分割す...
-
特定の文字がある行以外を削除...
-
Excel グラフのプロットからデ...
-
A1に入力された文字列と同じ文...
-
アクティブになっている行をマ...
-
エクセルマクロで偶数行(又は...
-
Excel:いまフォーカスがあるセ...
-
excel 小さすぎて見えないセル...
-
Excel ウインドウ枠の固定をす...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで特定の文字列が入っ...
-
エクセル マクロ オートフィ...
-
【Excel関数】UNIQUE関数で"0"...
-
結合されたセルをプルダウンの...
-
[EXCEL]ボタン押す→時刻が表に...
-
excel 小さすぎて見えないセル...
-
AのセルとB行を比較して、一致...
-
エクセル マクロで数値が変っ...
-
エクセル 上下で列幅を変えるには
-
excelのデータで色つき行の抽出...
-
Excel グラフのプロットからデ...
-
エクセル2016で時間を入力して...
-
VBAで色の付いているセルの行削除
-
特定の文字がある行以外を削除...
-
連続データが入った行の一番右...
-
エクセルVBA 最終行を選んで並...
-
エクセルのセルに指定画像(.jpg...
-
エクセルで昨日までの日付デー...
-
エクセルマクロで偶数行(又は...
-
A1に入力された文字列と同じ文...
おすすめ情報