本帖最后由 张雄友 于 2013-10-30 20:21 编辑
修改一下。- Sub 转换()
- Dim ar1(), ar2(), r&, c&, i&
- Set 数据源区域 = Application.InputBox("请选择源区域", "VBA", , , , , , 8)
- ar1 = 数据源区域.Value
- LL = InputBox("请输入要转几列?", "VBA", 8)
- If LL <> "" Then
- If LL > 256 Then
- MsgBox "2003版本不能满足设定的格式!"
- Exit Sub
- End If
- End If
- ReDim ar2(1 To Int((UBound(ar1) + LL - 1) / LL), 1 To LL)
- r& = 1
- c& = 1
- For i& = 1 To UBound(ar1)
- ar2(r, c) = ar1(i, 1)
- c = c + 1
- If c > LL Then
- r = r + 1
- c = 1
- End If
- Next
- Set Rng = Application.InputBox("请选择存放区域起始单元格", "VBA", , , , , , 8)
- If Rng Is Nothing Then Exit Sub
- Rng.CurrentRegion.ClearContents
- Rng.Resize(UBound(ar2), UBound(ar2, 2)) = ar2
- End Sub
复制代码 |