Excel VBA質問箱 IV

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

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


55811 / 76732 ←次へ | 前へ→

【25688】Re:3つのコードと合致するデータに新しいコードを振る方法
回答  Hirofumi  - 05/6/10(金) 21:36 -

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

Sheet2に、Aコード且つ、Bコード且つ、Cコードの物が複数ある場合
このメッセージを出して終了する様に就くって有ります
Sheet2に、Aコード且つ、Bコード且つ、Cコードの物の、
Dコードが違っているなら、コードの振り直しは出来ないのでは?(一意になら無い為)
Dコードが同じなら、以下の様に成ります

Option Explicit

Public Sub Sample2()

  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
        'Dコードが違うなら
        If .Item(vntKey) <> vntData(i, 4) Then
          strProm = "Keyが重複しています"
          GoTo Wayout
        End If
      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
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 回答

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