Dim Arr, Brr(), R%, K%
'原始資料入陣列Arr
With Sheets("sheet1")
Arr = Range(.[D2], .Cells(Rows.Count, "F").End(3))
End With
'整理資料,Arr=>Brr
For R = 1 To UBound(Arr)
If Arr(R, 1) <> "" And Arr(R, 3) <> "" Then '排除D、F列空白
K = K + 1: ReDim Preserve Brr(1 To 2, 1 To K)
Brr(1, K) = Arr(R, 1): Brr(2, K) = Arr(R, 3)
End If
Next R
Brr = Application.Transpose(Brr)
'塞入資料 Brr => ListBox
With ListBox1
.List = Brr
.ColumnCount = UBound(Brr, 2)
End With作者: wang077 時間: 2021-7-18 20:15