有的時候我們需要將excel多個工作表中相同的某一列的數據提取出來合併彙總入一個工作表中,當然我們可以用複製、粘貼的方式來完成,但是如果工作表數量很多,那麼複製、粘貼的方法效率顯然很差,這時本文所介紹的VBA的方法不失為一種好的解決方法。
工具/原料
excel
VBA
方法/步驟
分別有工作表1、2、3、4,數據如下圖示:
按ALT+F11打開VBE編輯器,在工程窗口下的Microsoft Excel對象右鍵-插入-模塊,新建一個模塊1。
粘貼如下代碼:
Option Explicit
Sub columncopy()
Dim c As String, sh As Worksheet, i As Integer, flag As Boolean, b As String, arr, l As Integer, j As Integer, min As Integer, max As Integer
flag = False
c = InputBox("請輸入列號,如:A、B、C……", "列號輸入(請輸入大寫字母)")
For i = 1 To Sheets.Count
If Sheets(i).Name = "第" & c & "列合併數據" Then flag = True
Next
If flag = False Then
Set sh = Worksheets.Add
sh.Name = "第" & c & "列合併數據"
Sheets("第" & c & "列合併數據").Move after:=Sheets(Sheets.Count)
End If
b = InputBox("請指定需合併列的工作表,多張連續表請用“-”隔開,多張不連續表請用“,”隔開,如:1,2,3-5,6等。", "指定工作表(請輸入數字)")
arr = Split(b, ",", -1, vbTextCompare)
If Sheets("第" & c & "列合併數據").Range("iv1").End(xlToLeft).Column = 1 Then
l = Sheets("第" & c & "列合併數據").Range("iv1").End(xlToLeft).Column
Else
l = Sheets("第" & c & "列合併數據").Range("iv1").End(xlToLeft).Column + 1
End If
For i = 0 To UBound(arr)
If InStr(arr(i), "-") Then
min = Split(arr(i), "-", -1, vbTextCompare)(0)
max = Split(arr(i), "-", -1, vbTextCompare)(1)
For j = min To max
Sheets(j).Columns(c & ":" & c).Copy Destination:=Sheets("第" & c & "列合併數據").Cells(1, l)
l = l + 1
Next j
Else
Sheets(CInt(arr(i))).Columns(c & ":" & c).Copy Destination:=Sheets("第" & c & "列合併數據").Cells(1, l)
l = l + 1
End If
Next
End Sub
按ALT+F8打開宏對話框窗口,鼠標單擊執行columncopy宏。
在彈出的“列號輸入(請輸入大寫字母)”對話框中輸入所需的列號(筆者測試輸入:“B”列),點確定。
在彈出的“指定工作表(請輸入數字)”對話框中按照要求輸入所需的工作表(筆者測試輸入:“1,2-3,4”即為第1,2至3,4張工作表),點確定。
最後得到如圖示的效果。