下記のような感じで、大量のドメインが記載されているExcelシートから、特定のドメインのみを着色するマクロを書きたいです。
Excelシートの例
A | B | C | |
---|---|---|---|
1 | ドメイン | 日付 | |
2 | example.com | 2017/05/08 | |
3 | example.jp | 2017/05/07 | |
4 | etc.example.jp | 2017/05/07 | |
5 | example.ne | 2017/05/06 | |
︙ | ︙ | ︙ | ︙ |
テキストファイルの例
example.jp teratail.com test.xyz example.ne
(上記の場合なら重複しているexample.jpとexample.neを着色したい)
上記のExcelシートとは別に、ドメインを一行ずつリストアップしたテキストファイルを用意し、そこに載っているドメインのセルの背景色を赤色に着色したいです。
量が非常に多く、数万件あるのでなるべく負荷のかからないようにコーディングする必要があります。
下記の私が考えた方法はあまりにも時間がかかりすぎたり、負荷が高すぎてExcel自体が応答しなくなりダメでした。
よろしければ知恵をお貸しください。
######(案)テキストファイルを一行ずつ読み込み、配列に代入し、Excelシートのセルを1番上から一つずつ参照し、配列を一つずつlike演算子で検証する
lang
1OpenFileName = Application.GetOpenFilename("テキスト文書,*.txt") 2 If OpenFileName <> "False" Then 3 Workbooks.Open OpenFileName 4 Else 5 GoTo hoge 6 End If 7 8 'リストの読み込み 9 Open OpenFileName For Input As #1 10 Workbooks(1).Activate 11 Do Until EOF(1) 12 ReDim Preserve ng_domain(a) 13 Line Input #1, buf 14 ng_domain(a) = buf 15 i = 2 16 Do While Cells(i, 1) <> "" 17 If Cells(i, 1).Value Like "*" + ng_domain(n) + "*" Then 18 Cells(i, 1).Interior.Color = RGB(242, 221, 220) 19 Else 20 End If 21 i = i + 1 22 Loop 23 a = a + 1 24 Loop 25 Close #1
もしくは
lang
1Do While Cells(i, 1) <> "" 2 For n = n To a 3 If Cells(i, 1).Value Like "*" & ng_domain(n) & "*" Then 4 Cells(i, 1).Interior.Color = RGB(242, 221, 220) 5 Else 6 7 End If 8 Next n 9 n = 0 10 i = i + 1 11Loop
何か良い案はありませんでしょうか…。
よろしくお願い致します。
(2017/05/05 追記)
Nuu様
迅速なご回答ありがとうございます。
ご提案頂いたコードを下記のように実行しました。
VBA
1Sub テスト() 2 3 q1 = MsgBox("実行", 0, "") 4 If q1 = vbCancel Then 5 MsgBox "キャンセル", 0, "" 6 GoTo endmark 7 Else 8 End If 9 10 Close #1 11 openfilename = Application.GetOpenFilename("テキスト文書,*.txt") 12 Open openfilename For Input As #1 13 14 Do Until EOF(1) 15 Line Input #1, buf 16 With Workbooks(1).Worksheets(1).Columns(1) 17 .AutoFilter Field:=1, Criteria1:="*" & buf & "*" 18 .CurrentRegion.SpecialCells(xlCellTypeVisible).Interior.Color = RGB(242, 221, 220) 19 .AutoFilter 20 a = a + 1 21 Application.StatusBar = a & "件目" 22 End With 23 Loop 24 Workbooks(1).Worksheets(1).Rows(1).Interior.Color = xlNone 25 26endmark: 27End Sub 28
(コード全てです)
上記コードで実行したところ、非常に時間がかかっているのでまだコードが完了するまで実行できていないのですが、
Escキーで中断すると、画像のような表示になります。
フィルターというものがよく理解できていないのですが、正常に処理できているのでしょうか?
稚拙な質問で大変申し訳ありません。
何卒よろしくお願い致します。
回答4件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2017/05/12 09:38
2017/05/12 15:30
2017/05/14 02:40