Excel VBA質問箱 IV

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

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


34245 / 76738 ←次へ | 前へ→

【47703】Re:二つのデータを見比べて、新リストを作成
発言  ichinose  - 07/3/19(月) 18:50 -

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

>実際に全部試して見ましたが、エラーになってしまいました。
私も他の方のコードも全部試しました。
きちんとC列にデータが表示されていましたよ!!
(Win2000&Excel2002で確認)

こういう場合、想定しているデータがMia さんと回答者では違う
又は、試行データに想定以外のデータがある場合をよく経験します。


で、サンプルデータもこちらで作ってしまいます。


新規ブック(Sheet1というシート名が存在する)の標準モジュールに

'=================================================================
Option Explicit
Sub main()
  Call mk_sample 'サンプルデータを作成
  MsgBox "ご覧のデータで処理をします"
  Call test
End Sub
'=================================================================
Sub mk_sample()
  With Worksheets("sheet1")
    .Activate
    .Cells.Clear
    .Range("a1:c1").Value = Array("参加予定者", "実際の参会者", "延べ参加者?")
    .Range("a2:a8").Value = Application.Transpose(Array( _
            "01-Aさん", "02-Bさん", _
            "03-Cさん", "04-Dさん", _
            "05-Eさん", "06-Fさん", _
            "07-Gさん"))
    .Range("b2:b8").Value = Application.Transpose(Array( _
            "01-Aさん", "03-Cさん", _
            "03-Cさん", "06-Fさん", _
            "11-Jさん(突然参加者)", _
            "11-Jさん(突然参加者)", _
            "13-Lさん(突然参加者)"))
    End With
End Sub
'=====================================================================
Sub test()
  Dim marray As Variant
  Dim rng As Range
  Dim crng As Range
  Dim ans As Variant
  Dim dkey As Variant
  Dim dat As Variant
  Dim num As Long
  Dim g0 As Long
  Dim g1 As Long
  Dim g2 As Long
  If Cells(Rows.Count, "b").End(xlUp).Row > 1 Then
    With CreateObject("scripting.dictionary")
     ans = Application.Transpose(Range("b2", Cells(Rows.Count, "b").End(xlUp)).Value)
     For g0 = LBound(ans) To UBound(ans)
       dkey = Val(Split(ans(g0), "-")(0))
       If .Exists(dkey) Then
        marray = .Item(dkey)
        marray(1) = marray(1) + 1
        .Item(dkey) = marray
       Else
        .Add dkey, Array(ans(g0), 1)
        End If
       Next
     Set rng = Range("a2", Cells(Rows.Count, "a").End(xlUp))
     If rng.Row > 1 Then
       For Each crng In rng
        dkey = Val(Split(crng.Value, "-")(0))
        If Not .Exists(dkey) Then
          .Add dkey, Array(crng.Value, 1)
          End If
        Next
       End If
     g0 = LBound(.Keys)
     g1 = 2
     Do While g0 <= UBound(.Keys)
       dat = .Item(Application.Small(.Keys, g0 + 1))(0)
       num = .Item(Application.Small(.Keys, g0 + 1))(1)
       For g2 = 1 To num
        Cells(g1, 3).Value = dat
        g1 = g1 + 1
        Next
       g0 = g0 + 1
       Loop
     End With
    End If
End Sub


これでmainを実行してみてください。
testというプロシジャーは、前回投稿のままです。
mk_sampleでMia さんの投稿を基にしたサンプルデータを作成しています。

これでC列にデータが作成されるか試してみてください。

これが動作するようなら、ご自分の動作しないデータと何が違うのか
見比べてください。
0 hits

【47625】二つのデータを見比べて、新リストを作成 Mia 07/3/16(金) 19:31 質問
【47627】Re:二つのデータを見比べて、新リストを作成 ウッシ 07/3/16(金) 20:15 発言
【47628】Re:二つのデータを見比べて、新リストを作成 Hirofumi 07/3/16(金) 20:44 回答
【47629】Re:二つのデータを見比べて、新リストを作成 ichinose 07/3/16(金) 21:07 発言
【47644】Re:二つのデータを見比べて、新リストを作成 Mia 07/3/17(土) 13:25 質問
【47645】Re:二つのデータを見比べて、新リストを作成 ウッシ 07/3/17(土) 13:41 発言
【47646】Re:二つのデータを見比べて、新リストを作成 Kein 07/3/17(土) 13:52 回答
【47647】Re:二つのデータを見比べて、新リストを作成 Hirofumi 07/3/17(土) 14:01 回答
【47696】Re:二つのデータを見比べて、新リストを作成 Mia 07/3/19(月) 16:45 質問
【47698】Re:二つのデータを見比べて、新リストを作成 Kein 07/3/19(月) 17:02 発言
【47700】Re:二つのデータを見比べて、新リストを作成 Mia 07/3/19(月) 17:59 質問
【47703】Re:二つのデータを見比べて、新リストを作成 ichinose 07/3/19(月) 18:50 発言
【47704】Re:二つのデータを見比べて、新リストを作... ichinose 07/3/19(月) 18:52 発言
【47657】Re:二つのデータを見比べて、新リストを作成 ichinose 07/3/17(土) 19:01 発言
【47686】Re:二つのデータを見比べて、新リストを作成 Mia 07/3/19(月) 7:33 お礼

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