原創作者： 盧子 轉自：Excel不加班

那時的現金日記賬彙總表，是用VBA 公式完成，分成了兩步。現在盧子看了，有點多此一舉，直接VBA一步到位，這樣堪稱完美。

每一家銀行日記賬格式都一樣，餘額都放在E列，現在要實現将銀行還有對應的最後餘額提取到彙總表。

先來看最終效果，點下彙總按鈕，1秒鐘就搞定，還給你一個提示對話框"報告盧子，提取完畢"。

今天就不錄制宏了，教你如何在原來的基礎上面改代碼。

前面一直有提到目錄的代碼。

Sub 目錄()

Dim i As Integer

For i = 2 To 6

Range("a" & i) = Sheets(i).Name

Next

End Sub

這個代碼其實是不智能的，需要每次都數一下有多少工作表，将6改成Sheets.Count，讓代碼幫你數工作表。這樣就可以智能的，不管多少工作表都可以。

更完美的目錄提取代碼就出來了。

Sub 目錄()

Dim i As Integer

For i = 2 To Sheets.Count

Range("a" & i) = Sheets(i).Name

Next

End Sub

接下來，怎麼提取每個銀行的E列最後一個有金額的值。

先不看VBA，用技巧實現。随便點E列下方空白單元格，按一下Ctrl ↑，就回到E列最後一個有金額的值了。

在最後餘額的下方，選一個沒有内容的空單元格。比如E3000，E5000都行，因為餘額在哪個單元格不确定，為了确保在這個單元格的下方，直接寫一個非常大的單元格，比如E60000，也就是Range("E60000")。

方向有下左右上，xlup就是上，也就是Range("E60000").End (xlUp)。

向上以後，是要提取這個單元格的值Value，也就是Range("E60000").End(xlUp).Value。

到此，需要的都有了。

Sub 彙總()

Dim i As Integer

For i = 2 To Sheets.Count

Range("a" & i) = Sheets(i).Name

Range("b" & i) = Sheets(i).Range("E60000").End(xlUp).Value

Next

End Sub

如果要發給其他人使用，經常會加個提示對話框MsgBox "報告盧子，提取完畢"，不加也行，沒啥影響。

最終代碼。

Sub 彙總()

Dim i As Integer

For i = 2 To Sheets.Count

Range("a" & i) = Sheets(i).Name

Range("b" & i) = Sheets(i).Range("E60000").End(xlUp).Value

Next

MsgBox "報告盧子，提取完畢"

End Sub

将原來的内容清除掉，運行代碼，驗證效果。

會點技巧、公式，借鑒思路，從而實現寫各種VBA代碼。

,