Question

如何编写VB，使Excel可以批量合并单元格

我想要在Excel中编写程序，可以批量合并单元格，希望能达到以下效果：
1、第1行内容永远不会参与合并。
2、从第2行开始，每3列为一个小组。每个小组中的第1列与第2列内容合并在第3列中，同时保留第1列与第2列原有的内容。在合并前，应先清空第3列的内容，然后再把第1、2列的内容合并到第3列中。具体请见图。3、我编写了以下的程序，但没有达到我上述的目的。请高手帮忙修改。谢谢！
Sub xxx() For i = 1 To Range("XFD1").End(xlToLeft).Column Step 3
Range(Cells(2, i + 2), Cells(1000, i + 2)).ClearContents
For j = 2 To Cells(65536, i + 1).End(xlUp).Row
Cells(j, i + 2) = Cells(j, i) & " " & Cells(j, i + 1)
Next

End Sub

Answer 1

Sub xxx()
For i = 1 To cells(1,columns.count).End(xlToLeft).Column Step 3 '列遍历
if Cells(rows.count,i).End(xlUp).Row=1 then goto nn
For j = 2 To Cells(rows.count,i).End(xlUp).Row  '行遍历

cells(j,i+2)=cells(j,i) & " " & cells(j,i+1)
next j
Next i
nn:
end sub

追问

这个编程只能输出第一组数据，其它组数据没有执行程序，烦请高手帮我修改

追答

Sub xxx()
For i = 1 To cells(1,columns.count).End(xlToLeft).Column Step 3 '列遍历
if Cells(rows.count,i).End(xlUp).Row=1 then goto nn
For j = 2 To Cells(rows.count,i).End(xlUp).Row  '行遍历
cells(j,i+2)=cells(j,i) & " " & cells(j,i+1)
next j
nn:   '这个nn:写错位置了，呵呵。
Next i
end sub

Answer 2

Sub test()
Dim Arr, Brr, I, J, TTLrow
For I = 1 To Range("XFD1").End(xlToLeft).Column Step 3
 TTLrow = Cells(Rows.Count, I).End(xlUp).Row
 ReDim Arr(1 To TTLrow - 1, 1 To 3): ReDim Brr(1 To TTLrow - 1)
 Range(Cells(2, I + 2), Cells(TTLrow, I + 2)).ClearContents
 Arr = Range(Cells(2, I), Cells(TTLrow, I + 2))
 For J = LBound(Arr) To UBound(Arr)
  Brr(J) = Arr(J, 1) & " " & Arr(J, 2)
 Next J
 Cells(2, I + 2).Resize(UBound(Brr)) = Application.Transpose(Brr)
Next
End Sub