スキルアップ・問題解決なら、モーグにおまかせ！

数日前に、町内会の抽選会に利用したくて、次のような質問をしました。
 
例えば、1000人の名簿から、Ａグループ20人、Ｂグループ15人、・・・というように、数を決めてランダムに抽出する方法は、Excelで可能でしょうか？ちなみに抽出数の合計は100人で、グループ数は15です。
名簿は、
1 ○○さん　Ａ
2 ××さん　Ａ
3 □□さん　Ｂ
4 △△さん　Ｂ
5 ●●さん　Ｃ
･ ・・・・　・
･ ・・・・　・
というような一覧表です。よろしくお願いします。
 
 
その後、半平太さんから次のようにご回答頂きました。
 
一般機能でも、下の手順で出来そうですけどね。。
  
１．グループ別の当選者数を下図(G1:I2)の様に埋める(サンプルでは、3グループ、計10人）
２．C2セルに=RAND()　と入力して、フィルダウン
３．C列全体をコピーして、値の貼付け
  
４．乱数にダブりがないか、D2に数式を入れて、念のため確認する。
　　D2セル =IF(OR(COUNTIF(C2:C1200,C2:C1200)>1),"有","無")
  
５．G3セル =XLOOKUP(TAKE(SORT(FILTER($C$2:$C$1200,$B$2:$B$1200=G1)),G2),$C$2:$C$1200,$A$2:$A$1200,"")
　　と入力して、右へコピー
  
<結果図>
行 ___A___ ____B____ _______C_______ __D__ _E_ ____F____ ___G___ ___H___ ___I___
 1 氏名 グループ 乱数生成後値化 重複 グループ Ａ Ｂ Ｃ
 2 Name01 Ａ 0.594714537 無 当選者数 5 2 3
 3 Name02 Ａ 0.554952974 Name07 Name12 Name14
 4 Name03 Ａ 0.323293225 Name03 Name09 Name16
 5 Name04 Ａ 0.723990988 Name02 Name13
 6 Name05 Ａ 0.974484221 Name01
 7 Name06 Ａ 0.939029356 Name04
 8 Name07 Ａ 0.085922578
 9 Name08 Ｂ 0.94932929
10 Name09 Ｂ 0.264407234
11 Name10 Ｂ 0.564305458
12 Name11 Ｂ 0.554734358
13 Name12 Ｂ 0.030535968
14 Name13 Ｃ 0.478480494
15 Name14 Ｃ 0.058312015
16 Name15 Ｃ 0.82291206
17 Name16 Ｃ 0.153581672
 
 
小生のPCでは問題なく動作したのですが、町内会のPCがEXCEL2019だったため、XLOOKUPは動作しませんでした。
お恥ずかしい話ですが、EXCEL019でも上記のような抽出が可能でしょうか。
よろしくお願いいたします。

Microsoft 365 じゃないと数式では面倒なので、本来のVBAにします。
 
１．「作業」と言う名前のシートを一枚挿入してください。
２．基本データが入っているシートを「抽選」と言うシート名に変えてください。
３．抽選シートは下図の様にデータをセットしてください。
 
<抽選 シート　初期状態>

行  ___A___  ____B____  _C_  ____D____  _E_  _F_  _G_  _H_  _I_
 1  氏名     グループ        グループ   Ａ   Ｂ   Ｃ   ・   ・ 
 2  Name01   　Ａ            当選者数    5    2    3   ・   ・ 
 3  Name02   　Ａ                                             
　　　：　　　：

行 ___A___ ____B____ _C_ ____D____ ___E___ ___F___ ___G___ _H_ _I_
 1 氏名    グループ      グループ  　Ａ      Ｂ      Ｃ     ・  ・ 
 2 Name01     Ａ         当選者数     5       2       3     ・  ・ 
 3 Name02     Ａ                   Name07  Name08  Name14         
 4 Name03     Ａ                   Name03  Name11  Name16         
 5 Name04     Ａ                   Name01          Name15         
 6 Name05     Ａ                   Name02                         
 7 Name06     Ａ                   Name04                         
 8 Name07     Ａ                                                  

Sub lottery()
    Dim ws抽選 As Worksheet
    Dim ws作業 As Worksheet
    Dim lastRW As Long, gTopRW
    Dim Grp As Range
    Dim rToSearch As Range
    
    Set ws抽選 = Worksheets("抽選")
    Set ws作業 = Worksheets("作業")
    
    ws作業.Range("A1") = "Dummy"
    ws作業.UsedRange.ClearContents
    
    With ws抽選
        Intersect(.UsedRange.Offset(1), .Columns("A:C")).Copy ws作業.Range("A1")
    End With
    
    With ws作業
        lastRW = .Cells(Rows.Count, "A").End(xlUp).Row
        
        With .Range("C1:C" & lastRW)
            .FormulaLocal = "=RAND()"
            .Value = .Value
        End With
        
        .Range("D1").FormulaArray = "=IF(OR(COUNTIF(C1:C1500,C1:C1500)>1),""有"",""無"")"
        
        If .Range("D1") = "有" Then
            MsgBox "乱数に重複があります。再試行してください"
            Exit Sub
        End If
        
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range("B1"), Order:=xlAscending
        .Sort.SortFields.Add Key:=.Range("C1"), Order:=xlAscending
        
        .Sort.SetRange .Range("A1:C" & lastRW)
        .Sort.Header = xlNo
        .Sort.Apply
        
        ws抽選.Range("E3").Resize(lastRW, 100).ClearContents
        
        Set rToSearch = .Range("B1:B" & lastRW)
        
        For Each Grp In ws抽選.Range("E1", ws抽選.Cells(1, 100).End(xlToLeft))
            gTopRW = Application.Match(Grp, rToSearch, 0)
            
            If IsNumeric(gTopRW) Then
                With Grp
                    ws作業.Cells(gTopRW, "A").Resize(.Offset(1)).Copy Grp.Offset(2)
                End With
            End If
        Next Grp
    End With
End Sub

半平太さん、ありがとうございます。
結構大変そうですが、頑張ってみます。

半平太さん、出来ました！
大変助かりました。ありがとうございました。