Excel VBA質問箱 IV

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

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


55830 / 76732 ←次へ | 前へ→

【25668】Re:3つのコードと合致するデータに新しいコードを振る方法
質問  Lee  - 05/6/10(金) 9:32 -

引用なし
パスワード
   ▼Hirofumi さん:
>どのシートから探して、どのシートのどの列に書き込むのか解らないので?
>Sheet1、Sheet2が以下の様で、Sheet1のAコード、Bコード、Cコードを
>Sheet2因り探索して、Sheet1のD列に書きこむとしています
>
>Sheet1
>  A     B     C
> 1 Aコード  Bコード  Cコード
> 2 00001   001    010
> 3 00001   002    010
> 4 00002   001    010
> 5 ・     ・     ・
>
>Sheet2
>  A     B     C     D
> 1 Aコード  Bコード  Cコード  Dコード
> 2 00001   001    010    001
> 3 00001   002    010    001
> 4 00002   001    010    002
> 5 ・     ・     ・    ・
>
>Option Explicit
>
>Public Sub Sample()
>
>  Dim i As Long
>  Dim vntData As Variant
>  Dim lngRows As Long
>  Dim rngResult As Range
>  Dim strResult() As String
>  Dim dicIndex As Object
>  Dim vntKey As Variant
>  Dim strProm As String
>  
>  '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, 4).Value
>  End With
>  
>  'Dictionaryオブジェクトのインスタンスを取得
>  Set dicIndex = CreateObject("Scripting.Dictionary")
>  'Indexを作成
>  With dicIndex
>    'データ全てに繰り返し
>    For i = 1 To lngRows
>      'Aコード、Bコード、CコードをKeyとする
>      vntKey = vntData(i, 1) & vbTab _
>            & vntData(i, 2) _
>              & vbTab & vntData(i, 3)
>      'もしKeyが重複する場合
>      If .Exists(vntKey) Then
>        strProm = "Keyが重複しています"
>        GoTo Wayout
>      Else
>        'KeyとDコードをIndexに登録
>        .Add vntKey, vntData(i, 4)
>      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, 3).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) _
>              & vbTab & vntData(i, 3)
>      'Keyが有ったら結果用配列に代入
>      If .Exists(vntKey) Then
>        strResult(i, 1) = .Item(vntKey)
>      End If
>    Next i
>  End With
>  
>  '結果を出力
>  With rngResult
>    .Offset(1, 3).Resize(lngRows).Value = strResult
>  End With
>  
>  strProm = "処理が完了しました"
>  
>Wayout:
>  
>  Set dicIndex = Nothing
>  Set rngResult = Nothing
>  
>  Beep
>  MsgBox strProm
>  
>End Sub

おはようございます。
早速、シート名とコード名を差し替えて試してみたのですが
「Keyが重複しています。」
と表示され、Dコードは振られませんでした。。。
どうしたらいいのでしょうか?
元データにはA・B・Cコードが同じのもが複数あるからでしょうか?
1 hits

【25644】3つのコードと合致するデータに新しいコードを振る方法 Lee 05/6/9(木) 11:19 質問
【25658】Re:3つのコードと合致するデータに新しいコ... Hirofumi 05/6/9(木) 21:05 回答
【25668】Re:3つのコードと合致するデータに新しいコ... Lee 05/6/10(金) 9:32 質問
【25688】Re:3つのコードと合致するデータに新しいコ... Hirofumi 05/6/10(金) 21:36 回答
【25689】Re:3つのコードと合致するデータに新しいコ... Lee 05/6/10(金) 22:01 質問
【25690】Re:3つのコードと合致するデータに新しいコ... Lee 05/6/10(金) 22:07 質問
【25692】Re:3つのコードと合致するデータに新しいコ... Hirofumi 05/6/10(金) 22:32 回答
【25693】Re:3つのコードと合致するデータに新しいコ... Lee 05/6/10(金) 22:46 質問
【25694】Re:3つのコードと合致するデータに新しいコ... Hirofumi 05/6/10(金) 23:26 回答
【25695】Re:3つのコードと合致するデータに新しいコ... Hirofumi 05/6/11(土) 0:13 回答
【25696】Re:3つのコードと合致するデータに新しいコ... Lee 05/6/11(土) 0:53 お礼
【25698】Re:3つのコードと合致するデータに新しいコ... Hirofumi 05/6/11(土) 1:03 回答
【25699】Re:3つのコードと合致するデータに新しいコ... Lee 05/6/11(土) 1:15 お礼
【25697】Re:3つのコードと合致するデータに新しいコ... Hirofumi 05/6/11(土) 0:55 回答

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