Как добавить в список ListBox большое количество строк, чтобы это было быстро по времени?

Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const LB_INITSTORAGE = &H1A8
Private Const LB_ADDSTRING = &H180
 
Private Sub Command1_Click()
    Dim i As Integer
    Dim tick As Long
    
    List1.Clear
    tick = GetTickCount
    
    For i = 0 To 10000
        List1.AddItem i
    Next
    Me.Caption = GetTickCount - tick ' 1311 ml
End Sub
 
Private Sub Command2_Click()
    Dim i As Integer
    Dim tick As Long
    
    List1.Clear
    tick = GetTickCount
    
    List1.Visible = False
    
    For i = 0 To 10000
        List1.AddItem i
    Next
    
    List1.Visible = True
    
    Me.Caption = GetTickCount - tick ' 468 ml
End Sub
 
 
Private Sub Command3_Click()
    Dim i As Integer
    Dim tick As Long
    Dim str As String
    Dim hwndList As Long
    
    str = "123"
    hwndList = List1.hwnd
    
    List1.Clear
    tick = GetTickCount
    
    'List1.Visible = False
    
    Debug.Print SendMessage(hwndList, LB_INITSTORAGE, 10001, CLng(LenB(str) * 10001))
    
    For i = 0 To 10000
        SendMessage hwndList, LB_ADDSTRING, 0, StrPtr(str)
    Next
    'List1.Visible = True
    
    Me.Caption = GetTickCount - tick ' 1310 ml
End Sub

Private Sub ListBoxW1_ItemDraw(ByVal Item As Long, ByVal ItemAction As Long, ByVal ItemState As Long, ByVal hDC As Long, ByVal Left As Long, ByVal Top As Long, ByVal Right As Long, ByVal Bottom As Long)

Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
 
Private Sub Command1_Click()
    End
End Sub
 
Private Sub Form_Load()
    Dim i As Long
    Dim tick As Long
    
    ListView1.View = LvwViewReport
    ListView1.FullRowSelect = True
    ListView1.GridLines = True
    ListView1.HideColumnHeaders = True
    
    
    ListView1.ColumnHeaders.Add
    ListView1.ColumnHeaders.Add
    ListView1.ColumnHeaders.Add
    ListView1.ColumnHeaders.Add
    
    
    ListView1.ListItems.Add , , ChrW$(1234) & " aaaaa"
        ListView1.ListItems(1).SubItems(1) = ChrW$(&H88E7) & " Sub1 aaaa"
        ListView1.ListItems(1).SubItems(2) = ChrW$(&H88E7) & " Sub2 aaaa"
        ListView1.ListItems(1).SubItems(3) = ChrW$(&H88E7) & " Sub3 aaaa"
 
    
    tick = GetTickCount
    ListView1.Redraw = False
    
    For i = 1 To 10000
    
    ListView1.ListItems.Add , , ChrW$(1234) & " bbbbb"
    
    Next
    
    ListView1.Redraw = True
    Me.Caption = GetTickCount - tick
End Sub