Re: [問題] 請問EXCEL資料彙整的問題

[singermath (singer)]

提供兩個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
推 windyfun:我試看看  謝