Excel VBA質問箱 IV

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

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


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

【25723】3つのコード合致の応用 Lee 05/6/12(日) 0:22 質問[未読]
【25724】Re:3つのコード合致の応用 Hirofumi 05/6/12(日) 7:39 回答[未読]
【25733】Re:3つのコード合致の応用 Lee 05/6/13(月) 10:24 質問[未読]
【25755】Re:3つのコード合致の応用 Hirofumi 05/6/13(月) 18:59 回答[未読]
【25767】Re:3つのコード合致の応用 Lee 05/6/13(月) 23:47 質問[未読]
【25786】Re:3つのコード合致の応用 Hirofumi 05/6/14(火) 18:44 回答[未読]
【25787】Re:3つのコード合致の応用 Hirofumi 05/6/14(火) 18:58 回答[未読]
【25793】Re:3つのコード合致の応用 Lee 05/6/14(火) 22:15 お礼[未読]

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

引用なし
パスワード
   Hirofumiさん

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

'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

【25724】Re:3つのコード合致の応用
回答  Hirofumi  - 05/6/12(日) 7:39 -

引用なし
パスワード
   >昨日の続きで
>コードを2つに減らして試してみましたが、
>上手くいきません。。。
>どこがおかしいのでしょうか?

上手く行かない時は、どの部分がどの様に上手く行かないかを書かないと
上手く行かない理由が解らないよ(環境の相異等も関係する場合も有りますので)

多分、今回のは、★印の部分がエラーに成っていると思いますけど?

Option Explicit

Public Sub Sample3()
  
  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, 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)
      '★不正理由
      '行継続文字(_)アンダースコアが無いのに改行している
      '行継続文字を無くして1行にするか、行継続文字を入れる
      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)
      '★不正理由
      '行継続文字の前にSpaceが無い
      '行継続文字を無くして1行にするか、Spaceを入れる
      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

【25733】Re:3つのコード合致の応用
質問  Lee  - 05/6/13(月) 10:24 -

引用なし
パスワード
   ▼Hirofumi さん:
こんにちは。
ご指摘ありがとうございます。
環境はOS XPpro Excelは2003です。

ご指摘とおりに修正し、
実行したところ「Keyが重複しています」と表示されたので

取得したいデータの入ったSheetに重複検索をかけると、
数件の重複データが出力されました。

出力されたデータを確認すると、
Sheetには存在しないデータが重複行に表示されています。

うまく説明できなくて、申し訳ありません。
ご指導よろしくお願いいたします。

【25755】Re:3つのコード合致の応用
回答  Hirofumi  - 05/6/13(月) 18:59 -

引用なし
パスワード
   >ご指摘とおりに修正し、
>実行したところ「Keyが重複しています」と表示されたので
>
>取得したいデータの入ったSheetに重複検索をかけると、
>数件の重複データが出力されました。
>
>出力されたデータを確認すると、
>Sheetには存在しないデータが重複行に表示されています。
>
>うまく説明できなくて、申し訳ありません。
>ご指導よろしくお願いいたします。

此れだけでは、何とも答え様が無いのですが?

1、コードのTable(dicIndex)を作成するのに、データを配列に取得しますが
 この取得列位置が、合っていますか?
 提示されたコードでは、

  '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

 と、成っていますので、Sheet2のA列、B列、C列を取得し
 Keyは、A列、B列で、前の「Dコード」に相当する所がC列と成ります

2、「取得したいデータの入ったSheetに重複検索をかけると、
 数件の重複データが出力されました。」と有りますが?
 重複検索とは、何を使って行いましたか?
 また、「出力されたデータを確認すると、Sheetには存在しないデータが
 重複行に表示されています。」と有りますが?
 「存在」とは、全然別の列のデータでか?、
 其れともA列、B列に有っても不思議では無いデータですか?

【25767】Re:3つのコード合致の応用
質問  Lee  - 05/6/13(月) 23:47 -

引用なし
パスワード
   ▼Hirofumi さん:
こんばんは。

>1、コードのTable(dicIndex)を作成するのに、データを配列に取得しますが
> この取得列位置が、合っていますか?
> 提示されたコードでは、
>
>  '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
>
> と、成っていますので、Sheet2のA列、B列、C列を取得し
> Keyは、A列、B列で、前の「Dコード」に相当する所がC列と成ります

上記の2点は間違いありません。


>2、「取得したいデータの入ったSheetに重複検索をかけると、
> 数件の重複データが出力されました。」と有りますが?
> 重複検索とは、何を使って行いましたか?

Hirofumiさんに作成していたものを使用しました。

> また、「出力されたデータを確認すると、Sheetには存在しないデータが
> 重複行に表示されています。」と有りますが?
> 「存在」とは、全然別の列のデータでか?、

重複行で表示されているデータA・B・Cは
表示されている行番号には存在しません。
 
> 其れともA列、B列に有っても不思議では無いデータですか?

重複行に表示されたデータが
登録行に表示されているデータのAと
重複していることはあっても、
A・Bともに重複しているデータは
「取得したいデータの入ったSheet」にはありません。
きちんと説明できてますでしょうか?

【25786】Re:3つのコード合致の応用
回答  Hirofumi  - 05/6/14(火) 18:44 -

引用なし
パスワード
   >>2、「取得したいデータの入ったSheetに重複検索をかけると、
>> 数件の重複データが出力されました。」と有りますが?
>> 重複検索とは、何を使って行いましたか?
>
>Hirofumiさんに作成していたものを使用しました。

此れも、2つのコード用に修正しましたか?

Option Explicit

Public Sub Examination2()

  Dim i As Long
  Dim j As Long
  Dim vntData As Variant
  Dim lngRows As Long
  Dim lngRow As Long
  Dim rngResult As Range
  Dim vntResult As Variant
  Dim dicIndex As Object
  Dim vntKey As Variant
  Dim strProm As String
  Dim lngOffset As Long
  
  '検査結果を出力するSheetを設定
  Set rngResult = Worksheets("Sheet3").Cells(1, "A")
  With rngResult.Resize(, 8)
    .Value = Array("登録行", "Aコード", "Bコード", "Cコード", _
            "重複行", "Aコード", "Bコード", "Cコード")
  End With
  '検査結果出力用配列を確保
  ReDim vntResult(1 To 1, 1 To 8)
  lngRow = 1
  
  'Sheet2(Dコードの有るList)のList先頭セルを指定(列見出しの左上隅)
  With Worksheets("Sheet2").Cells(1, "A")
    'Offset量
    lngOffset = .Row
    'データ行数を取得
    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コード、CコードをKeyとする
      vntKey = vntData(i, 1) & vbTab _
            & vntData(i, 2)
      'もしKeyが重複する場合
      If .Exists(vntKey) Then
        vntResult(1, 1) = .Item(vntKey)
        vntResult(1, 5) = i + lngOffset
        For j = 1 To 3
          vntResult(1, j + 1) = vntData(vntResult(1, 1), j)
          vntResult(1, j + 5) = vntData(i, j)
        Next j
        vntResult(1, 1) = vntResult(1, 1) + lngOffset
        With rngResult.Offset(lngRow).Resize(, 8)
          .NumberFormatLocal = "@"
          .Value = vntResult
        End With
        lngRow = lngRow + 1
      Else
        'KeyとDコードをIndexに登録
        .Add vntKey, i
      End If
    Next i
  End With
  
  strProm = "処理が完了しました"
  
Wayout:
  
  Set dicIndex = Nothing
  Set rngResult = Nothing
  
  Beep
  MsgBox strProm
  
End Sub

【25787】Re:3つのコード合致の応用
回答  Hirofumi  - 05/6/14(火) 18:58 -

引用なし
パスワード
   >> また、「出力されたデータを確認すると、Sheetには存在しないデータが
>> 重複行に表示されています。」と有りますが?
>> 「存在」とは、全然別の列のデータでか?、
>
>重複行で表示されているデータA・B・Cは
>表示されている行番号には存在しません。

マクロ自体は、3つのコードを連結して1つのKeyにするのを、
2つのコードを連結して1つのKeyにする様に変更しただけなので
特に、変わった所は無いはずなので問題は無いと思います

「表示されている行番号には存在しません。」と言う所が気に成ります
Sheet1と2を間違えていませんか?

【25793】Re:3つのコード合致の応用
お礼  Lee  - 05/6/14(火) 22:15 -

引用なし
パスワード
   ▼Hirofumi さん:
>>> また、「出力されたデータを確認すると、Sheetには存在しないデータが
>>> 重複行に表示されています。」と有りますが?
>>> 「存在」とは、全然別の列のデータでか?、
>>
>>重複行で表示されているデータA・B・Cは
>>表示されている行番号には存在しません。
>
>マクロ自体は、3つのコードを連結して1つのKeyにするのを、
>2つのコードを連結して1つのKeyにする様に変更しただけなので
>特に、変わった所は無いはずなので問題は無いと思います
>
>「表示されている行番号には存在しません。」と言う所が気に成ります
>Sheet1と2を間違えていませんか?

こんばんは。

Sheetは間違えていませんでした。
重複マクロの2つのコードへの修正がきちんと出来ていなかったようです。
お騒がせしてすみませんでした。
いつも丁寧な指導に感謝しております。
次のステップは離れた列の3つのデータをKeyにしたいと思っています。
これからもよろしくお願いいたします。
ありがとうございました。

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