===一个巨难的Excel数据拆分问题=====

Question

我有一个excel表格，里面有很多合并的表格(请见链接的图片所示：http://www.geecity.com/1.jpg)，我的要求：把合并的表格拆分，然后都填补上值。特别注意：如果拆分前这个表格是空，那么拆分后的表格也都为空。===========================================================
我在网上找了一段程序，用excel的宏，打开excel的工具-宏-vb 编辑器-点击查看对象，拖上一个按钮，双击按钮，在后台写上如下程序：
Sub 取消合并且填充()
'
' 取消合并且填充 Macro
' 宏由 James 录制，时间: 2008-5-15
' 说明：不管三七二十一，一次性把当前工作表中所有的合并单元格都搞掂！宏从第一列开始逐列搜索直到遇到空列停止
' 宏会检查连续且有数据的所有格子，如果其中有空格，那就不同了：
' 对于数据中有空格：如果500行以下有空格，则宏忽略501行以下的格子。这个“500”在程序是可以看到的，可以手工改变它。    Dim find As Boolean, i As Integer
    Application.CutCopyMode = False
    Cells(1, 1).Select
    While ActiveCell.Text <> ""
        find = False
        i = 1
        If Selection.MergeCells Then
            Selection.UnMerge
            i = Selection.Areas(1).Rows.Count
            If i > 1 Then Selection.FillDown
            If Selection.Areas(1).Columns.Count > 1 Then Selection.FillRight
        End If
        ActiveCell.Offset(i, 0).Range("A1").Select
        While (Selection.Range("A1").Text <> "" And Not find) Or (Selection.Range("A1").Text = "" And ActiveCell.Row() < 500)
            If Selection.MergeCells Then find = True
            If Not find Then ActiveCell.Offset(1, 0).Range("A1").Select
        Wend
        If Not find Then
            ActiveCell.Offset(0, 1).Range("A1").Select
            Cells(1, ActiveCell.Column()).Select
        End If
    Wend
End SubPrivate Sub CommandButton1_Click()
取消合并且填充
End Sub
========================================================出现的问题：
如果合并的表格不为空，则正常拆分填补，但是如果这个合并的表格为空，就死在那里了。请问这是为什么？谢谢！

Answer 1

F8单步看执行情况，应该是while中条件有问题，修改一下就行.......

Answer 2

谢谢楼上，我把While ActiveCell.Text <> "" ... wend中间的程序都去掉也是死机，是不是和While ActiveCell.Text <> ""有关系啊

Answer 3

没有耐心啊！用F8加上debug.print看看变量变化过程，学会调试是开始学习的基本中的基本...

Answer 4

cqq_chen你不愿意回答少在这里瞎拽，你很有本事啊！

Answer 5

Sub 取消合并且填充()
    Dim iMaxCol As Long, iMaxRow As Long
    Dim iCol As Long, iRow As Long
    
    '用这个取数据范围
    iMaxCol = ActiveSheet.UsedRange.Columns.Count
    iMaxRow = ActiveSheet.UsedRange.Rows.Count
    
    Application.CutCopyMode = False
    For iCol = 1 To iMaxCol
        For iRow = 1 To iMaxRow
            Cells(iCol, iRow).Select
            
            If Selection.MergeCells Then
                Selection.UnMerge
                If Selection.Areas(1).Rows.Count > 1 Then Selection.FillDown
                If Selection.Areas(1).Columns.Count > 1 Then Selection.FillRight
            End If
        Next
    Next
End Sub

Answer 6

感谢Tiger_Zhao
不过我测试不通过，合并的数据没有拆分，数据也没有填补上。

Answer 7

看到这里，Tiger_Zhao不用自责了。

Answer 8

http://www.geecity.com/可能是他的网站

Answer 9

感谢Tiger_Zhao 提示，以下是正解Sub 取消合并且填充()
    Dim iMaxCol As Long, iMaxRow As Long
    Dim iCol As Long, iRow As Long
    
    '用这个取数据范围
    iMaxCol = ActiveSheet.UsedRange.Rows.Count  '和Tiger_Zhao的倒过来 
    iMaxRow = ActiveSheet.UsedRange.Columns.Count
    
    Application.CutCopyMode = False
    MsgBox iMaxCol
    For iCol = 1 To iMaxCol
    
        For iRow = 1 To iMaxRow
            Cells(iCol, iRow).Select
            
            If Selection.MergeCells Then
                Selection.UnMerge
                If Selection.Areas(1).Rows.Count > 1 Then Selection.FillDown
                If Selection.Areas(1).Columns.Count > 1 Then Selection.FillRight
            End If
        Next
    Next
End SubPrivate Sub CommandButton1_Click()
取消合并且填充
End Sub

Answer 10

Cells(iRow, iCol).Select
应该把这个倒过来，否则变量命名不当了。