【エクセルの質問です】約3000件の住所録があります。エクセルのデータで、一行につき一人の名前や住所などが入力されています。このデータには、重複が多く、重複を除き、無作為に1000件のデータを抽出したいのですが、どのような方法がベストでしょうか?ご教授下さい。よろしくお願いします。

回答の条件
  • 1人5回まで
  • 13歳以上
  • 登録:2012/02/21 14:59:10
  • 終了:2012/02/28 15:00:06

回答(2件)

id:oil999 No.1

oil999回答回数1728ベストアンサー獲得回数3202012/02/21 18:13:14

ポイント250pt

以下のマクロをお試しください。

オリジナルの住所録は、シート[Sheet1]のA列に名前が、B列に住所があるとします。
ランダムに抽出した結果は、シート[Sheet2]のA列とB列に代入します。
名前と住所の両方が重複しているデータは抽出しないようにしてあります。

なお、もしオリジナルの3000件から重複分を除いて1000件未満になっていると、このマクロは無限ループに陥ってしまいます。計算に時間がかかりすぎるようでしたら、ESCキーをクリックしてマクロを中断してください。

Option Explicit

Private SourSheet As String, DestSheet As String, Nums As Long

'メインプログラム
Sub main()
    SourSheet = "Sheet1"    'オリジナルのシート名
    DestSheet = "Sheet2"    '抽出先のシート名
    Nums = 1000             '抽出件数
    
    Dim name As String, address As String
    Dim maxrow As Long, i As Long, r As Long
    maxrow = Worksheets(SourSheet).Range("A1").End(xlDown).Row
    Call makeDestSheet
    
    i = 0
    While (i < Nums)
        r = Round(Rnd() * maxrow, 0)
        If (r = 0) Then r = 1
        name = Worksheets(SourSheet).Cells(r, 1).Value
        address = Worksheets(SourSheet).Cells(r, 2).Value
        If (isDup(name, address, i) = False) Then
            i = i + 1
            Call addItem(name, address, i)
        End If
    Wend
End Sub

'重複しているかどうか
Function isDup(name As String, address As String, n As Long) As Boolean
    Dim i As Long
    isDup = False
    For i = 1 To n
        If (Worksheets(DestSheet).Cells(i, 1) = name And Worksheets(DestSheet).Cells(i, 2) = address) Then
            isDup = True
            i = n + 1
        End If
    Next i
End Function

'1行追加
Sub addItem(name As String, address As String, n As Long)
    Worksheets(DestSheet).Cells(n, 1).Value = name
    Worksheets(DestSheet).Cells(n, 2).Value = address
End Sub

'データシート作成
Private Sub makeDestSheet()
    Dim ws As Worksheet
    Dim flag As Boolean
    
    flag = False
    For Each ws In Worksheets
        If ws.name = DestSheet Then flag = True
    Next ws
    If (flag = True) Then
        Worksheets(DestSheet).Cells.Clear
    Else
        Set ws = Worksheets.Add
        ws.name = DestSheet
    End If
End Sub

id:mario-16 No.2

蝸牛角上争何事回答回数219ベストアンサー獲得回数212012/02/27 19:00:23

ポイント250pt

まず以下の方法にしたがって重複したデータが見えないようにします。
重複データを削除する-フィルタオプション:Excel エクセルの使い方-データベース/検索

次に以下の方法にしたがってデータとして使っていない列にrand関数を入力しその列で並べ替えをします。
先頭から欲しい行数だけを抜き出してください。
ランダムな並べ替え-RAND関数:Excel エクセルの使い方-データベース/検索

重複したデータを完全に削除してしまっても良ろしければ以下のような方法もございます。
Excel2007で重複データを削除する-重複の削除:Excel 2007 エクセル2007の使い方

ご確認ください。

  • id:SALINGER
    countifsとrand関数でできなくもないが、マッチ条件が複数になると3万件の処理が重そうなんでやっぱVBAかな。
  • id:SALINGER
    桁1個間違えたか。なら数式でも実用に耐えそう。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません