| |
▼hama さん：
こんにちは〜
○○の一つ覚えですが、Dictionaryを使った方法です。
Sub Try1()
Const CLSID_DataObject = "1C3B4210-F441-11CE-B9EA-00AA006B1A69"
Dim i As Long
Dim u, v
Dim r As Range
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
'Sheet2の表をコピーして辞書に登録します
With Worksheets("Sheet2")
With .Range("A1").CurrentRegion
.Resize(, 2).Copy 'A,B列をTABで連結文字列にする
v = .Columns(3).Value 'C列の記号
End With
End With
With GetObject("new:" & CLSID_DataObject)
.GetFromClipboard
u = Split(.GetText, vbCrLf)
End With
For i = 0 To UBound(u) - 1
dic(u(i)) = v(i + 1, 1) '例 dic("さ" & vbTab & "た") = "●"
Next
'Sheet1のA+B列データが辞書にあるか検索
With Worksheets("Sheet1")
With .Range("A1").CurrentRegion
.Resize(, 2).Copy 'A,B列をTABで連結文字列にする
Set r = .Columns(3).Cells
v = r.Value 'C列の記号
End With
End With
With GetObject("new:" & CLSID_DataObject)
.GetFromClipboard
u = Split(.GetText, vbCrLf)
End With
Application.CutCopyMode = True
For i = 0 To UBound(u) - 1
If dic.Exists(u(i)) Then
v(i + 1, 1) = dic(u(i)) ' "☆" ← dic("あ" & vbTab & "か")
Else
v(i + 1, 1) = "×"
End If
Next
r.Value = v
End Sub
Dictionary(辞書)というのは メモリ上のLOOKUP表のことで、
今回のケースでは Sheet2の表を
A列データとB列データをTAB記号で区切って連結した文字列を キーとし、
対応するデータ(アイテムと言います)に C列の記号をという組データを
登録しておきます。
そして Sheet1 の A列+TAB+B列 文字列がDictionaryのキーに登録してあれば
> If dic.Exists(u(i)) Then
で、True が返ってきますから、辞書内の u(i) キーに対応する アイテムを
C列用配列にコピーしていき（辞書になければ そこは × を代入し）
最後にまとめてシートのC列に配列を貼り付けます。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 13/12/10(火) 0:25 -
