作者singermath (singer)
看板Office
标题Re: [问题] 请问EXCEL资料汇整的问题
时间Sun Sep 9 16:05:30 2007
提供两个VBA仅供参考
(刚学没多久，若有错请多包涵)
1. data2top() :对每一行把非空资料往上移动，直到该行往下无非空资料为止。
(仅针对 每一行的数值(数字或文字)
，若包含公式则不动作，如=a1*b3)
2. data2left():同上，不过是把资料往左边移动。
可两个搭配来用，如:先用1再用2。
(我预设范围是用 usedrange ，可能会有点小问题
若知道确定范围，可自行修改第3行
原本:Set rng=ActiveSheet.UsedRange
修改:Set rng=Range("a1:k100") 'a1:k100 是自订范围
程式码如下:
Sub data2top()
Dim rng As Range, do_col As Range
Set rng = ActiveSheet.UsedRange
rng_col = rng.Columns.Count
j = 1
Do While j <= rng_col
i = 1
Do
Set do_col = ActiveSheet.Cells(i, j).Range("a1")
If IsEmpty(do_col.End(xlDown)) Then
Exit Do
ElseIf IsEmpty(do_col) Then
do_col.Value = do_col.End(xlDown).Value
do_col.End(xlDown).Clear
End If
i = i + 1
Loop
j = j + 1
Loop
MsgBox "done..."
End Sub
Sub data2left()
Dim rng As Range, do_row As Range
Set rng = ActiveSheet.UsedRange
rng_row = rng.Rows.Count
i = 1
Do While i <= rng_row
j = 1
Do
Set do_row = ActiveSheet.Cells(i, j).Range("a1")
If IsEmpty(do_row.End(xlToRight)) Then
Exit Do
ElseIf IsEmpty(do_row) Then
do_row.Value = do_row.End(xlToRight).Value
do_row.End(xlToRight).Clear
End If
j = j + 1
Loop
i = i + 1
Loop
MsgBox "done..."
End Sub
--
※ 发信站: 批踢踢实业坊(ptt.cc)
◆ From: 59.114.40.210
1F：推 windyfun:我试看看 谢 09/09 22:27