[[20061026001356]]　『不一致データを抽出したい』（たろう）　ページの最後に飛ぶ

『不一致データを抽出したい』（たろう）

このように、AとBに数字がならんでて、不一致のものだけCに空白なしで表示させたいのですが、どうしたらいいでしょうか？
どなたか教えてください。

 「フィルタオプションの設定」を使っても宜しければ
 以前このような質問がありました。
[[20050224120843]]『リスト１とリスト２を比較して無いものを抽出』（ヨロ）

 ちなみにこの過去ログは、全文検索で「不一致　抽出」として検索し
 3番目に表示された過去ログの中で「参考」として紹介されていたものです。

 (HANA)

 以前弥太郎さんから　お教えいただいたマクロです。
 (Ty)
 Sub 弥太郎さん差分()
     Dim Non_data(), tbl_1
     Dim tbl As Range
     Dim i As Long, n As Long
         tbl_1 = Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row).Value
         Set tbl = Cells(1, 2).Resize(Cells(Rows.Count, 2).End(xlUp).Row)
         For i = 1 To UBound(tbl_1, 1)
             If WorksheetFunction.CountIf(tbl, tbl_1(i, 1)) = 0 Then       'A列ひくB列
             'If WorksheetFunction.CountIf(tbl, tbl_1(i, 1)) = 1 Then　    'A列にあってB列にある
                 ReDim Preserve Non_data(n)
                 Non_data(n) = tbl_1(i, 1)
                 n = n + 1
             End If
         Next i
    ActiveCell.Offset(0).Resize(UBound(Non_data) + 1) = Application.Transpose(Non_data)
  End Sub

 弥太郎さんのマクロは確か　差分　と書いたセルをアクティブにして実行するように
 なっとったと思うんですが・・・
 でないと、とんでもない所にデータを拾い出してしまいまっせ。（笑
 せやから
     If ActiveCell <> "差分" Then Exit Sub　の挿入と
    ActiveCell.Offset(1).Resize(UBound(Non_data) + 1) = Application.Transpose(Non_data)
 の書き換えが必要ですワ。
 それとあのマクロ、データ量が多いと時間かかりまんなぁ。（10000行で9秒ほど）

 あんなマクロは廃棄処分にして、ニューバージョンに差し替えたらどうでっしゃろ？
 これやと１秒以内できっちし作業をこなしてくれます、ハイ。
 同じく差分と入力したセルをアクティブにして実行します。
 　　　　　　（弥太郎）

 '--------------------------------------
 Sub 差分速度重視()
    Dim dic As Object, tbl, data
    Dim i As Long,j As Long,n As Long

    Set dic = CreateObject("scripting.dictionary")
    If ActiveCell <> "差分" Then Exit Sub
    tbl = Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row, 2).Value
    For i = 1 To UBound(tbl, 1)
        If Not IsEmpty(tbl(i, 2)) Then
            dic(tbl(i, 2)) = Empty
        End If
    Next i

    ReDim data(1 To UBound(tbl, 1), 1 To 1)
    For j = 1 To UBound(tbl, 1)
        If Not dic.exists(tbl(j, 1)) Then
            n = n + 1
            data(n, 1) = tbl(j, 1)
        End If
    Next j
    If n > 0 Then
       ActiveCell.Offset(1).Resize(n) = data
    End If
    Set dic = Nothing
 End Sub
 エラー処理を追加 9:13

 弥太郎さん
 いつもありがとうございます。
 中日が負けて　明日は暇ですので
 dictionaryを少し勉強いたします。
 (Ty)

コメント返信：

[ 一覧(最新更新順) ]

[[20061026001356]] 『不一致データを抽出したい』（たろう） ページの最後に飛ぶ

[[20061026001356]]　『不一致データを抽出したい』（たろう）　ページの最後に飛ぶ