我有一张 Excel 表
A 1234
1234
1234
1234
B 12
12
等等
我需要一张纸
A 1234 1234 1234 1234
B 12 12
答案1
这是一个 VBA 宏,用于按指示重新排列数据
它处理活动工作表,并假设 1) 数据从单元格 A1 开始,2) 行或列中没有间隙,3) 工作表上没有其他数据,4) 数据由值(而非公式)组成,5) 格式不需要保留。
Sub OneColumn()
Dim rng As Range
Dim vSrc As Variant
Dim vDst As Variant
Dim cl As Range
Dim ws As Worksheet
Dim rwSrc As Long, rwDst As Long
Dim i As Long
Set ws = ActiveSheet
' find the right most used column
Set cl = ws.UsedRange.Find("*", [A1], xlValues, , xlByColumns, xlPrevious)
' in case there is no data on the sheet
If Not cl Is Nothing Then
' get a range bounding the data
Set rng = Range(ws.[A1], ws.[A1].End(xlDown).Offset(, cl.Column - 1))
' copy source data to an array
vSrc = rng
' size another array large enough (too large) to hold destination data
' (note: vDst is transposed to allow for later redim preserve)
ReDim vDst(1 To 2, 1 To UBound(vSrc, 1) * (UBound(vSrc, 2) - 1))
' loop through the source data, copying to the destination array
rwDst = 1
For rwSrc = 1 To UBound(vSrc, 1)
vDst(1, rwDst) = vSrc(rwSrc, 1)
For i = 2 To UBound(vSrc, 2)
If vSrc(rwSrc, i) <> "" Then
vDst(2, rwDst + i - 2) = vSrc(rwSrc, i)
Else
Exit For
End If
Next
rwDst = rwDst + i - 2
Next
' discard excess size from destination array
ReDim Preserve vDst(1 To 2, 1 To rwDst)
' clear old data from sheet
rng.Clear
' put result on sheet
[A1].Resize(UBound(vDst, 2), 2) = Application.Transpose(vDst)
End If
End Sub