Option Explicit
Sub TEST()
Dim Arr, N&, i&, j&
Arr = Range([D1], Cells(ActiveSheet.UsedRange.Rows.Count, "A"))
For i = 2 To UBound(Arr)
N = N + 1: Arr(N, 1) = ""
For j = 1 To UBound(Arr, 2)
If Trim(Arr(i, j)) <> "" Then
If Arr(N, 1) = "" Then
Arr(N, 1) = "'" & Trim(Arr(i, j))
Else
Arr(N, 1) = Arr(N, 1) & "," & Trim(Arr(i, j))
End If
End If
Next
Next
[E2].Resize(N, 1) = Arr
Set Arr = Nothing
End Sub作者: av8d 時間: 2023-2-14 17:56