[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『EXCEL VBA 検索して色塗り』（たちお） Excel2003、WindowsXP
最近ﾜｰｸｼｰﾄ関数からEXCEL VBAへのｽﾃｯﾌﾟｱｯﾌﾟを試みております。 しかし、あまりの難解さに早くもくじけそうです…。
さて、
ファイルAからマクロを実行し、ファイルBを開き、
ファイルAの、sheet("台帳")の、A列(データ入力されている)の全セル値を、
ファイルBの、全ワークシートの、A列に一致するものがあるか検索し、
該当するものがある場合、ファイルBの該当セルの色を赤色に変える。
といったマクロを作成したく思っております。 丸投げで申し訳け有りませんが、 どの様な記述をすればよいのか、 何方かご教授お願いします。
以下が、見様見真似で私が書いたコードです。 ファイルBを開く迄は動きましたが、そこから先がチンプンカンプン（死語）です。 まるでダメなコードと思われますが、やろうとしている事がお解り頂けたら幸いです。
Sub sample() 'ファイルAに記述したマクロ
Dim myfile As Variant Dim mysheet As Worksheet Dim mycell As Variant Dim mycelladd As String Dim DAICYOU As Variant Dim i As Long
'ファイルBの選択
myfile = Application.GetOpenFilename(filefilter:="ｴｸｾﾙﾌｧｲﾙ(*.xls),*xls")
If myfile = False Then
MsgBox "キャンセルされました"
Exit Sub
Else
Workbooks.Open Filename:=myfile
End If
'検索と色塗り
ThisWorkbook.Worksheets("台帳").Activate
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
DAICYOU = Range(i, 1).Value
myfile.Activate
For Each mysheet In Worksheets
mysheet.Select
With mysheet.Range("A1:A65536")
Set mycell = .Find(DAICYOU, LookIn:=xlValues)
If Not mycell Is Nothing Then
mycelladd = mycell.Address
Do
mycell.Interior.ColorIndex = 3
Set mycell = .FindNext(mycell)
Loop While mycell.Value = DAICYOU And mycell.Address <> mycelladd
End If
End With
Next
Next i
End Sub
ThisWorkbookが「A」の場合 こんな感じでどうでしょう。
開いたファイルの各シートA列にある【値】を 全角半角区別【無く】、【完全一致】でさがします。
'------
Sub 開いたファイルの検索と色塗り()
Dim mycellAdr As String, oFile As String
Dim mycell As Object, myFile As Variant, tbl As Variant
'ファイルの選択
myFile = Application.GetOpenFilename(filefilter:="ｴｸｾﾙﾌｧｲﾙ(*.xls),*xls")
If myFile = False Then
MsgBox "キャンセルされました"
Exit Sub
Else
Workbooks.Open Filename:=myFile
End If
oFile = Dir(myFile, vbDirectory)
'検索と色塗り
tbl = Workbooks("A.xls").Sheets("台帳").Range("A1").CurrentRegion
For i = 1 To Workbooks(oFile).Sheets.Count
With Workbooks(oFile).Sheets(i)
.UsedRange.Interior.ColorIndex = xlNone
With .Range("A:A")
For ii = 1 To UBound(tbl, 1)
Set mycell = .Find(What:=tbl(ii, 1), LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByColumns, MatchByte:=False)
If Not mycell Is Nothing Then
mycellAdr = mycell.Address
Do
mycell.Interior.ColorIndex = 3
Set mycell = .FindNext(mycell)
Loop Until mycell.Address = mycellAdr
End If
Next
End With
End With
Next
End Sub
'------
(HANA)
初めて VBA を覚えるときには、Select したり Activate するのはわかりやすい かもしれませんが、その反面、選択されているシートが期待したものでないとき に、思い通りにならないなど、コード以外の状態も考えなければならなくなります。
できれば、早い段階で HANA さんが提示されたようにブックやシートを含めた 指定方法を覚えたほうがよいでしょう。 http://officetanaka.net/excel/vba/speed/s2.htm
ところで、提示されたコードは、そこそこ動くようにみえるのですが、どこが わからないのでしょうか。 http://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub04_200.html
まずは、デバッグ方法を習得されるのが、何よりの近道かと思います。 (Mook)
ファイルBが固定では無かったようなので、コードを差し替えました。 既にコピーした後でしたら、変更しましたのでご確認下さい。
(HANA)
済みません、もう一回変更しました。。。
なお、気になる点をいくつか
＞DAICYOU = Range(i, 1).Value
１列目のi行目 と言う事ならCell(i, 1)
Rangeを使って書くなら Range("A" & i) ですね。
また、これは
アクティブに成っているブックの
アクティブに成っているシートの
該当セルの値を DAICYOUに入れます。
一番最初に実行するときは
＞ThisWorkbook.Worksheets("台帳").Activate
が、アクティブに成っているブックの
アクティブに成っているシートです。
＞myfile.Activate
ブックBをアクティブにする を記録に録ると
『Windows("B.xls").Activate』が記録されます。
となると、Windows(≪ブック名≫).Activate
と書く必要がありますよね。
また、myfileにはフルパスが入っていますので
ここからブック名だけを取り出して入れ込む必要が有ります。
＞mysheet.Select ここも「Sheet1をアクティブにする」を記録にとってコードを確認。 それから、「mysheet」から シート名だけを取り出す事も必要です。
＞Loop While mycell.Value = DAICYOU And mycell.Address <> mycelladd 前半部分の「mycell.Value = DAICYOU」ここは良く分からないですが （必ず成立しますよね？この値をさがして居るのですから。） 「mycell.Address <> mycelladd」これは、一回目は必ず成立しませんよね。 （Loop While なので、成立して次に行ってもらう必要が有るのですが・・・。）
初めて検索した場合 ＞mycelladd = mycell.Address で、「=」にしているのですから。
Worksheetsが一回りしたら Next i ＞DAICYOU = Range(i, 1).Value アクティブブックのアクティブシートの 該当セルの値が、次の検索値に成りますが この時、アクティブになっているのは 「開いたファイルの一番最後のシート」 ですよね？ ここに検索値は有りません。
他にも有るかもしれませんが、気付いた所です。
Mookさんも書いて居られますが 「デバッグ方法を習得」が出来れば もう少しコードを作りやすくなると思います。
(HANA)
(HANA)さん、(Mook)さん、色々と有難う御座います。 記述して頂いたコードで作業は実行出来ました。 多数アドバイスして頂きながら恐縮ですが、 正直、私のレベルではまだ理解できない文言も多数有ります。 ここは御二人の言われる通りデバッグ方法なるものを勉強してみます。
さて、 強欲ながらもう一つ応用を利かせたいのですが、 「ファイルBの、全ワークシートの、A列に一致」の部分ですが、 対象列がAでなく他の列（例えばE列）になった場合は、 どの様にコードを変更すれば良いでしょうか？（たちお）
検索対象列の変更が簡単に出来るようにコードを変更しました。
.UsedRange.Interior.ColorIndex = xlNone
With .Range("A:A")
の「"A:A"」をご希望の列に変更してください。
また、実行前に他の列についている色を消したく無い場合は
With Workbooks(oFile).Sheets(i).Range("A:A")
.Interior.ColorIndex = xlNone
For ii = 1 To UBound(tbl, 1)
Set mycell = .Find(What:=tbl(ii, 1), LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByColumns, MatchByte:=False)
If Not mycell Is Nothing Then
mycellAdr = mycell.Address
Do
mycell.Interior.ColorIndex = 3
Set mycell = .FindNext(mycell)
Loop Until mycell.Address = mycellAdr
End If
Next
End With
Next
End Sub
の様にしてください。
実行前に捜す列についている色もそのままにしておきたい場合は
↑のコードの内
.Interior.ColorIndex = xlNone
を消してください。
(HANA)
うぉぉ！バッチリです。 色々お気遣い頂き有難う御座います。(たちお)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.