Option Explicit

Private Sub CommandButton1_Click()
Dim lastRow As Long
Dim myData, myData2(), myno
Dim i As Long, j As Long, cn As Long

' If TextBox1.Value = "" Or TextBox2.Value = "" Or TextBox3.Value = "" Then End

With Worksheets("Sheet1")

lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
myData = .Range(.Cells(1, 1), .Cells(lastRow, 6)).Value
End With

ReDim myData2(1 To lastRow, 1 To 6)
ReDim myData2(1 To 6)
For i = LBound(myData) To UBound(myData)

If myData(i, 4) Like "?" & TextBox1.Value & "*" And myData(i, 6) Like "*" & TextBox2.Value & "*" And myData(i, 2) Like "*" & TextBox3.Value & "*" Then
cn = cn + 1

ListBox1.AddItem  '★追加
ListBox1.List(cn - 1, 1) = myData(i, 1) '★追加
ListBox1.List(cn - 1, 2) = myData(i, 2) '★追加
ListBox1.List(cn - 1, 3) = myData(i, 3) '★追加
ListBox1.List(cn - 1, 4) = myData(i, 4) '★追加
End If

Next

With ListBox1
.ColumnCount = 5
.ColumnWidths = "40;80;60;50;170"
'.List = myData2 '★不要
End With

End Sub

Sub test()
    Dim 一覧() As String

    '処理の都合で最初の一人だけ名前をセットしておく '
    ReDim Preserve 一覧(10, 0)
    一覧(0, 0) = Range("B2")

    For r = 2 To Cells(Rows.Count, 2).End(xlUp).Row  '2行目から最後まで調べる '
        名前 = Cells(r, "B")  'B列から名前を取り出す '

        '名前が一覧の配列の中にあるか調べる '
        n = -1
        For i = 0 To UBound(一覧, 2)
            If 一覧(0, i) = 名前 Then n = i
        Next i

        'なかったらその人の行を追加 '
        If n = -1 Then
            n = UBound(一覧, 2) + 1
            ReDim Preserve 一覧(10, n)
            一覧(0, n) = 名前
        End If

        'D列とF列の数字の範囲に札を持っているフラグをセット '
        For i = Cells(r, "D") To Cells(r, "F")
            一覧(i, n) = 1
        Next i
    Next r

    '結果を整理して出力 '
    For r = 0 To UBound(一覧, 2)
        '一人ずつフラグを見ながら、変数sに数字をまとめる '
        s = ""
        For i = 1 To 10
            If 一覧(i, r) <> "" Then s = s & "、" & i  'どんどん追加 '
        Next i
        s = Mid(s, 2, 30)  '先頭の読点を消す '
        Debug.Print 一覧(0, r), s
    Next r

End Sub

Sub test()
    Dim 一覧() As String

    '処理の都合で最初の一人だけ名前をセットしておく
    ReDim Preserve 一覧(10, 0)
    一覧(0, 0) = Range("B2")

    For r = 2 To Cells(Rows.Count, 2).End(xlUp).Row  '2行目から最後まで調べる
        名前 = Cells(r, "B")  'B列から名前を取り出す

        '名前が一覧の配列の中にあるか調べる
        n = -1
        For i = 0 To UBound(一覧, 2)
            If 一覧(0, i) = 名前 Then n = i
        Next i

        'なかったらその人の行を追加
        If n = -1 Then
            n = UBound(一覧, 2) + 1
            ReDim Preserve 一覧(10, n)
            一覧(0, n) = 名前
        End If

        'D列とF列の数字の範囲に札を持っているフラグをセット
        For i = Cells(r, "D") To Cells(r, "F")
            一覧(i, n) = 1
        Next i
    Next r

    '結果を整理して出力
    For r = 0 To UBound(一覧, 2)
        '一人ずつフラグを見ながら、変数sに数字をまとめる
        s = ""
        For i = 1 To 10
            If 一覧(i, r) <> "" Then s = s & "、" & i  'どんどん追加
        Next i
        s = Mid(s, 2, 30)  '先頭の読点を消す
        Debug.Print 一覧(0, r), s
    Next r

End Sub

Option Explicit

'事前に
'・InternetExplorerのインターネットオプションで保護モードを有効にする
'・VBEの参照設定で"Microsoft Internet Controls"にチェックを入れる
    
Sub test()

    'InternetExplorer起動
    Dim objIE As InternetExplorer
    Set objIE = New InternetExplorer
    
    'サイトを表示
    objIE.Visible = True
    
    'ラインのサイト
    objIE.Navigate "https://line.me/ja/download"
    
    'ラインのサイトが完全に開くまで待機する
    Do While objIE.Busy = True Or objIE.readyState < READYSTATE_COMPLETE
    Loop
    
        'ダウンロードボタンを押す
    objIE.document.getElementsbytagname("a")(34).Click

    
    Set objIE = Nothing
    
End Sub

Option Explicit

'事前に
'・InternetExplorerのインターネットオプションで保護モードを有効にする
'・VBEの参照設定で"Microsoft Internet Controls"にチェックを入れる
    
Sub test()

    'InternetExplorer起動
    Dim objIE As InternetExplorer
    Set objIE = New InternetExplorer
    
    'サイトを表示
    objIE.Visible = True
    
    'ラインのサイト
    objIE.Navigate "https://line.me/ja/download"
    
    'ラインのサイトが完全に開くまで待機する
    Do While objIE.Busy = True Or objIE.readyState < READYSTATE_COMPLETE
    Loop
    
    'aタグ要素のHTMLを全て書き出す
    Dim i As Long
    For i = 0 To objIE.document.getElementsbytagname("a").Length - 1
        ThisWorkbook.Worksheets(1).Cells(i + 2, 2) = objIE.document.getElementsbytagname("a")(i).outerHTML
    Next
    
    Set objIE = Nothing
    
End Sub

Option Explicit
Sub sample()
  Dim V4 As String
  Dim V5 As Object
  Dim V6 As Object
  Dim LastRow As Long
  Dim i As Long
  Dim key As String
  ' 画面更新を一時停止
  Application.ScreenUpdating = False
  ' 検索用の辞書
  Set V5 = CreateObject(“Scripting.Dictionary”)
  Set V6 = CreateObject(“Scripting.Dictionary”)

  ' 4列目の最終行を取得
  LastRow = Sheet(2).Cells(Rows.Count,4).End(xlUp).Row
  ' 検索用辞書を作成
  For i = 1 To LastRow
    V4 = Sheet(2).Cells(i,4)
    If V4 <> "" Then
      V5.Add V4, Sheet(2).Cells(i,5).Value
      V6.Add V4, Sheet(2).Cells(i,6).Value
    End If
  Next

  ' Sheet(1)の最終行を取得
  LastRow = Sheet(1).Cells(Rows.Count,1).End(xlUp).Row
  For i = 1 To LastRow
    key = Sheets(1).Cells(i, 5).Value
    If V5.Exists(key) Then '辞書に検索語が存在するか確認
      Sheets(1).Cells(i, 6).Value = V5.Item(key)
      Sheets(1).Cells(i, 7).Value = V6.Item(key)
    End If
  Next
  ' 画面更新を再開
  Application.ScreenUpdating = True
end Sub