[已解决]现有一份表格如图，想要合并一下，没有很好的思路，请大神指点

诺然偶然 · 发表于 2017-4-11 10:36

本帖最后由诺然偶然于 2017-4-13 19:28 编辑

现有一份表格如图，想要合并一下，没有很好的思路，请大神指点

最佳答案

xdragon

2017-4-11 13:57

Sub 合并区域()
Application.ScreenUpdating = False
Dim max_col As Long, i As Long
Cells.Clear
With Sheets("原表格")
.Range("A1").CurrentRegion.Resize(1).Copy Range("A1")
max_col = .UsedRange.Columns.Count
For i = 1 To max_col Step 5
.Cells(1, i).CurrentRegion.Offset(1).Resize(.Cells(1, i).CurrentRegion.Rows.Count - 1).Copy Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1)
Next
End With
Application.ScreenUpdating = True
End Sub

复制代码

偷懒写法，哈哈

xdragon · 发表于 2017-4-11 13:57

Sub 合并区域()
Application.ScreenUpdating = False
Dim max_col As Long, i As Long
Cells.Clear
With Sheets("原表格")
.Range("A1").CurrentRegion.Resize(1).Copy Range("A1")
max_col = .UsedRange.Columns.Count
For i = 1 To max_col Step 5
.Cells(1, i).CurrentRegion.Offset(1).Resize(.Cells(1, i).CurrentRegion.Rows.Count - 1).Copy Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1)
Next
End With
Application.ScreenUpdating = True
End Sub

复制代码

偷懒写法，哈哈

诺然偶然 · 发表于 2017-4-13 19:27

谢谢大神，能用的，这两天有点忙回头在好好研究下

		自动登录	找回密码
密码			注册