[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『<ｺｰﾄﾞ表？を参照するﾏｸﾛ処理について教えてください。』
小生50歳になる、VBAマクロについては初心者の者です。
過去の質問・回答の中にあるのかも知れませんが、見つけることができ
ないためお願いします。
下のようにシート1の1行A列,D,G,･･･････,2行A列,D,G,･･･････というよ
うに順にセルに値をVBA（マクロ)で入力していくとき、その都度シート3
のリストと照合し、数値がﾏｯﾁした場合は一つ右のセルに当該文字を入れ
て当該数値の色を赤にしていくことを考えています。シート1のセルには
数式等が残らないように、照合した結果マッチするものがないときは空白
のままにしておき当該数値の色も変えないでおくという条件でマクロで処
理する方法はｍないでしょうか･････
関数VLOOKUPを使用するのではないかとは思うのですが、上手くいきません。
また、関数VLOOKUPを使用しない方法があればそれも教えてください。
(まとな)
イメージ
ｼｰﾄ1
A B C D E F G H I - - V W X -
1 102 103 104 岩沢 109
2 110 111 山本 112 117
3 118 119 120 125
-
-
7 150 151 152 小川
8 158
9
-
-
ｼｰﾄ3
A B C D E -
1 岩沢 104
2 山本 111
3 小川 152
4 長崎 158
5 横川 179
6 立川 196
-
-
[エクセルのバージョン]
Excel2003
[OSのバージョン]
WindowsXP
VLOOKUP関数は、コードが左側にないと使えません。範囲がわからないので 取り合えずですが、下記が一例です。 （純丸）(o^-')b Sub test() Dim dic As Object Dim hani As Range Dim i As Long Dim myr As Range Dim lastrow As Long
Set dic = CreateObject("Scripting.Dictionary")
Set hani = Worksheets("Sheet1").Range("A1:A10,D1:D10,G1:G10") '←範囲を設定
With Worksheets("Sheet3")
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastrow
dic.Add .Cells(i, 2).Value, .Cells(i, 1).Value
Next i
End With
For Each myr In hani
myr.Offset(, 1).Value = dic(myr.Value)
Next myr
End Sub
私はMatch関数で参加。
Sub test()
Dim lng_LastRow As Long, lng_LastCol As Long
Dim C As Range
lng_LastRow = Cells.Find("*", , , , xlByRows, xlPrevious).Row
lng_LastCol = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
For Each C In Range(Cells(1, 1), Cells(lng_LastRow, lng_LastCol))
C.Font.ColorIndex = 0
myMatch = Application.Match(C.Value, Worksheets("Sheet3").Range("B1:B6"), 0) 'MATCH(検査値, 検査範囲, 照合の型
If IsNumeric(myMatch) Then
C.Offset(0, 1).Value = Worksheets("Sheet3").Cells(myMatch, 1).Value
C.Font.ColorIndex = 3
End If
Next C
End Sub
（川野鮎太郎） 純丸さんまでデクチョナリ・・・。＿/￣|○ il||li
ウフフフ、ひそかに勉強しておったのじゃ。(*^^)v （純丸）(o^-')b
解決済みなので、σ(^o^;)も参戦〜
純丸さんの「Dictionary」と、鮎さんの「Find」を組み合わせてみました。
Sub まとな()
Dim MyDic As Object
Dim MyA As Variant
Dim i As Long, n As Long
Set MyDic = CreateObject("Scripting.Dictionary")
With Worksheets("Sheet3")
MyA = .Range("A1", .Range("B" & Rows.Count).End(xlUp))
End With
For i = 1 To UBound(MyA, 1)
MyDic(MyA(i, 2)) = MyA(i, 1)
Next i
With Worksheets("Sheet1")
For i = 1 To .Cells.Find("*", , , , xlByRows, xlPrevious).Row
For n = 1 To .Cells.Find("*", , , , xlByColumns, xlPrevious).Column Step 3
.Cells(i, n + 1) = MyDic.Item(.Cells(i, n).Value)
Next n
Next i
End With
Set MyDic = Nothing
Erase MyA
End Sub
（キリキ）（〃⌒o⌒)b
よく意味がわかりませんが、、、 条件付書式で色を付けるのはいかがでしょう？ （キリキ）（〃⌒o⌒)b
ｼｰﾄ1
A B C D E F G H I - - V W X -
1 102 103 (赤字)→104 岩沢←(赤字) 109
2 110 赤字→111 山本←(赤字) 112 117
3 118 119 120 125
-
-
- ※リストと一致しない他のセルには何もせず、
- 黒字入力のままにしておきたい。
-
ｼｰﾄ3
A B C D E -
1 岩沢 104
2 山本 111
3 小川 152
4 長崎 158
5 横川 179
6 立川 196
-
-
こんな感じではいかが？
Sub test()
Dim a, dic As Object, r As Range, i As Integer
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("sheet3") '<- リストがあるシート名に変更
a = .Range("a1",.Range("a" & Rows.Count).End(xlUp)).Resize(,2).Value
End With
For i = 1 To UBound(a,1)
If Not IsEmpty(a(i,2)) And Not dic.exists(a(i,2)) Then dic.add a(i,2), a(i,1)
Next
With Sheets("Sheet1").UsedRange '<- 要変更
For i = 1 To .Columns.Count Step 3
For Each r In Sheets("sheet1").Range(.Columns(i).Address)
If dic.exists(r.Value) Then
With r.Resize(,2)
.Value = Array(r.Value, dic(r.Value))
.Font.Color = vbRed
End With
End If
Next
Next
End With
Set dic = Nothing
End Sub
(seiya)
衝突しました。seiyaさんの後では恥ずかしいけどそのままＵＰ〜。 一部変えてみました。こういうことでしょうか？ （純丸）(o^-')b
Sub test() Dim dic As Object Dim hani As Range Dim i As Long Dim myr As Range Dim lastrow As Long
Set dic = CreateObject("Scripting.Dictionary")
Set hani = Worksheets("Sheet1").Range("A1:A10,D1:D10,G1:G10") '←範囲を設定
With Worksheets("Sheet3")
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastrow
dic.Add .Cells(i, 2).Value, .Cells(i, 1).Value
Next i
End With
For Each myr In hani
If dic(myr.Value) <> "" Then
myr.Offset(, 1).Value = dic(myr.Value)
myr.Resize(, 2).Font.ColorIndex = 3
End If
Next myr
End Sub
条件付書式で出来そうですが、、、 １）Sheet1 の A1〜好きな範囲を指定 ※上記で言えば、A1〜X3 まで ２）書式 → 条件付書式 「数式が」「=OR(ISNUMBER(A1)*COUNTA(B1),COUNTA(A1)*ISNUMBER(OFFSET(A1,,-1)))」 【書式】をクリックし、お好きな文字色に設定 以上でいかがでしょう？ （キリキ）（〃⌒o⌒)b
該当値の入力を忘れていましたので、コード変更しました (seiya)
>「ｺﾝﾎﾟｰﾈﾝﾄﾗｲｾﾝｽ情報が見つかりません。」
ちょっとした「おまじない」が必要なだけですｂ
>Set dic = CreateObject("Scripting.Dictionray")
~~
Set dic = CreateObject("Scripting.Dictionary")
~~
に変更すると、エクセル君の機嫌が直りますｗ
（キリキ）（〃⌒o⌒)b
解決したでしょうから、後出しでこっそり・・・。 私の書いたのは最初から色は変わったはず・・・＿/￣|○ il||li
（川野鮎太郎）
σ(^o^;)は、こう思いました。 「順丸さんのと、キリキのは、色が変わらないな〜？」 「川野さんのは、ちゃんと色が変わるのに」 「よし、もう一度聞いてみよう」 違ったのでしょうかね？？？ （キリキ）（〃⌒o⌒)b
恐らくそうでしょうね＾＾ 別に気にはしてませんから・・・＿/￣|○ il||li
（川野鮎太郎） ↑キリキさんの（〃⌒o⌒)bと同じトレードマークｗ
>別に気にはしてませんから・・・ いや、おおいに気ぃにしませう。 地味な人間は損でんなぁ、お互い（笑 地味な仲間見つけた（弥太郎） 派手の三羽ガラス (o^-')b （〃⌒o⌒)b (seiya)
いや〜、最初っから文字色のことが書いてありましたね。 まったく気が付きませんでした。申し訳ありません。m(__)m 順丸、おっと、じゃなくって、（純丸）(o^-')b
>順丸、おっと、じゃなくって、（純丸）(o^-')b あいや！ 最初からかかれてましたね。。。 携帯からとは言え、失礼ぶっこきました。。。 準丸さんすいませんm(_ _)m なんてねｗ ごめんなさいです。 （キリキ）（〃⌒o⌒)b
キリキさん、毎度どーもです。 ありがとうございました。
(地味なseiya)
σ(^o^;)も、よくわかりませんが、、、 モジュールには、色々なものがあります。 標準モジュール・シートモジュールなのです。 今回、皆さんが提示くださったコードは『標準モジュール』へ貼り付けるべきコードです。 >VBE画面最上段に「○○.xls-[Sheet3(ｺｰﾄﾞ)]」という表示がありました。 この状態から想像すると、Sheet3の『シートモジュール』に貼付けをしているのではないでしょうか？ VBE画面の、挿入 → 標準モジュール で、出てきた画面に貼付けをして試してみてください。 （キリキ）（〃⌒o⌒)b
c.Font.ColorIndex = 3 ↓ c.Resize(,2).Font.ColorIndex = 3
に変更してみてください
(seiya)
衝突〜☆ でも、そのままUP 川野さんではございませんが。。。 >For Each C In Range(Cells(1, 1), Cells(lng_LastRow, lng_LastCol)) の上に、 Range(Cells(1, 1), Cells(lng_LastRow, lng_LastCol)).Font.ColorIndex = 0 を追加 >C.Font.ColorIndex = 0 を 'C.Font.ColorIndex = 0 >C.Font.ColorIndex = 3 を、 C.Resize(, 2).Font.ColorIndex = 3 に追加・変更してみてください。 （キリキ）(〃⌒o⌒)b
みなさん、フォローありがとうございます。m(_ _)m ＞当該文字を入れて当該数値の色を赤にしていくことを考えています だったため、数値だけ色を変更していました。(^_^A;
＞関係者の方々を不快な気持ちにさせてしまったようですね。 いえいえ、全然不快になってませんから気にしないでください。
σ(^_^;)と（〃⌒o⌒)bさんのコミュニケーションのようなものですから。
（川野鮎太郎）
そそ＾＾ コミュニケーションですb がんばってくださいね＾＾ （キリキ）(〃⌒o⌒)b
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.