可以试试这个 Sub test() Data = Range("a2:d10") ReDim arr(1 To Range("a2:d10").Cells.Count, 1 To 1) For Each dat In Data m = m + 1 arr(m, 1) = dat Next Cells(1, "f").Resize(m, 1) = arr End Sub
Sub test() Dim Arr() Data = Range("a2:d10") For Each dat In Data If dat <> "" Then m = m + 1 ReDim Preserve Arr(1 To m) Arr(m) = dat End If Next Arr = Application.Transpose(Arr) Cells(1, "f").Resize(m, 1) = Arr End Sub
