Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

55776 / 76732

←次へ　｜　前へ→


	【25723】3つのコード合致の応用

Lee - 05/6/12(日) 0:22 -


	引用なし

	パスワード

Hirofumiさん

こんばんは。
昨日の続きで
コードを２つに減らして試してみましたが、
上手くいきません。。。
どこがおかしいのでしょうか？

'Sheet2のList先頭セルを指定（列見出しの左上隅）
　　With Worksheets("Sheet2").Cells(1, "A")
　　　　'データ行数を取得
　　　　lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row
　　　　If lngRows <= 0 Then
　　　　　　strProm = "データが有りません"
　　　　　　GoTo Wayout
　　　　End If
　　　　'データを配列に取得
　　　　vntData = .Offset(1).Resize(lngRows, 3).Value
　　End With
　　
　　'Dictionaryオブジェクトのインスタンスを取得
　　Set dicIndex = CreateObject("Scripting.Dictionary")
　　'Indexを作成
　　With dicIndex
　　　　'データ全てに繰り返し
　　　　For i = 1 To lngRows
　　　　　　'Aコード、BコードをKeyとする
　　　　　　vntKey = vntData(i, 1)
　　　　　　　　　　& vbTab & vntData(i, 2)
　　　　　　　　　　　　　　
　　　　　　'もしKeyが重複する場合
　　　　　　If .Exists(vntKey) Then
　　　　　　　　strProm = "Keyが重複しています"
　　　　　　　　GoTo Wayout
　　　　　　Else
　　　　　　　　'KeyとcｺｰドをIndexに登録
　　　　　　　　.Add vntKey, vntData(i, 3)
　　　　　　End If
　　　　Next i
　　End With
　　
　　'Sheet1のList先頭セルを指定（列見出しの左上隅）
　　Set rngResult = Worksheets("Sheet1").Cells(1, "A")
　　With rngResult
　　　　lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row
　　　　If lngRows <= 0 Then
　　　　　　strProm = "データが有りません"
　　　　　　GoTo Wayout
　　　　End If
　　　　vntData = .Offset(1).Resize(lngRows, 2).Value
　　End With
　　
　　'結果用配列を確保
　　ReDim strResult(1 To lngRows, 1 To 1)
　　'Sheet1のKeyをIndexから探索
　　With dicIndex
　　　　For i = 1 To lngRows
　　　　　　vntKey = vntData(i, 1)_
　　　　　　　　　　& vbTab & vntData(i, 2)
　　　　　　'Keyが有ったら結果用配列に代入
　　　　　　If .Exists(vntKey) Then
　　　　　　　　strResult(i, 1) = .Item(vntKey)
　　　　　　End If
　　　　Next i
　　End With
　　
　　'結果を出力
　　With rngResult
　　　　.Offset(1, 2).Resize(lngRows).Value = strResult
　　End With
　　
　　strProm = "処理が完了しました"
　　
Wayout:
　　
　　Set dicIndex = Nothing
　　Set rngResult = Nothing
　　
　　Beep
　　MsgBox strProm
　　
End Sub

0 hits

▼

【25723】3つのコード合致の応用 Lee 05/6/12(日) 0:22

≪