Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


1321 / 13644 ツリー ←次へ | 前へ→

【75083】シートを比較して同じだったら記号を入力 hama 13/12/10(火) 0:25 質問[未読]
【75085】Re:シートを比較して同じだったら記号を入力 kanabun 13/12/10(火) 10:29 発言[未読]
【75086】Re:シートを比較して同じだったら記号を入力 hama 13/12/10(火) 10:47 質問[未読]
【75087】Re:シートを比較して同じだったら記号を入力 kanabun 13/12/10(火) 11:11 発言[未読]
【75093】Re:シートを比較して同じだったら記号を入力 hama 13/12/10(火) 19:00 お礼[未読]

【75083】シートを比較して同じだったら記号を入力
質問  hama E-MAIL  - 13/12/10(火) 0:25 -

引用なし
パスワード
   Sheet2にA列とB列2つの検索対象となる値とC列に入力したい文字があります。
Sheet1には記号が入っていないのでマクロで記号を入れたいのです。
また、Sheet2の検索値にないものはSheet1では×にしたいです。
どう作ればよいのかわかりません。どなたか教えてください。

Sheet1
  A  B  C
1 あ か
2 さ た
3 は ま
4 や ら
・ ・ ・
・ ・ ・
・ ・ ・

Sheet2
  A  B C
1 さ た ●
2 は ま ○
3 あ か ☆
4 や ら ★
・ ・ ・ ※
・ ・ ・ ◆
・ ・ ・ !
・ ・ ・ %
・ ・ ・ ◇
・ ・ ・ #

比較後、Sheet1のC列にSheet2C列にある記号を入力

Sheet1完成
  A  B  C
1 あ か ☆
2 さ た ●
3 は ま ○
4 や ら ★
・ ・ ・ ◆
・ ・ ・ ◇
・ ・ ・ ※
・ ・ ・ ×
・ ・ ・ #
・ ・ ・ %

【75085】Re:シートを比較して同じだったら記号を...
発言  kanabun  - 13/12/10(火) 10:29 -

引用なし
パスワード
   ▼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列に配列を貼り付けます。

【75086】Re:シートを比較して同じだったら記号を...
質問  hama E-MAIL  - 13/12/10(火) 10:47 -

引用なし
パスワード
   ▼kanabun さん
回答ありがとうございます。
実はA列+B列=C列の記号というか値が100とおり以上あります。
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
  
を100以上書かなくては駄目でしょうか?

【75087】Re:シートを比較して同じだったら記号を...
発言  kanabun  - 13/12/10(火) 11:11 -

引用なし
パスワード
   ▼hama さん:

>▼kanabun さん
>回答ありがとうございます。
>実はA列+B列=C列の記号というか値が100とおり以上あります。

これは、いいかえれば、Sheet2の表は 100行以上ということですよね?

>  For i = 0 To UBound(u) - 1
>    dic(u(i)) = v(i + 1, 1) '例 dic("さ" & vbTab & "た") = "●"
>  Next
>  
>を100以上書かなくては駄目でしょうか?

変数u に 全データが入り、これを0番目から UBound(u) - 1 番目まで
For〜Nextで順に辞書に登録していますので、150あろうと、1500あろうと

>  For i = 0 To UBound(u) - 1
>    dic(u(i)) = v(i + 1, 1)
>  Next

でOKです。

【75093】Re:シートを比較して同じだったら記号を...
お礼  hama E-MAIL  - 13/12/10(火) 19:00 -

引用なし
パスワード
   ▼kanabun さん:
無事完成しました。ありがとうございました。
例のコメントを見て勘違いしました。
100行も書かずそのままいけました。
本当にありがとうございました。

1321 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free