Excel VBA 拆分工作薄-數組方法

網友有這樣一個表格：

B~K列每行有1000+的數據，需把每列最後單元格網上500個數據，分配到指定文件夾的各指定工作簿的A列。（注：每個文件夾中包含相同的工作簿）

具體的要求如下：

• 把B列最後單元格往上500個數據，填入工作簿名"白色"的A列。
• 把C列最後單元格往上500個數據，填入工作簿名"金絲"的A列。
• 把D列最後單元格往上500個數據，填入工作簿名"銀絲"的A列。
• 把E列最後單元格往上500個數據，填入工作簿名"咖啡色"的A列。
• 把F列最後單元格往上500個數據，填入工作簿名"黑金剛"的A列。
• 把G列最後單元格往上500個數據，填入工作簿名"天藍色"的A列。
• 把H列最後單元格往上500個數據，填入工作簿名"淺藍色"的A列。
• 把I列最後單元格往上500個數據，填入工作簿名"橘黃色"的A列。
• 把J列最後單元格往上500個數據，填入工作簿名"雪牙色"的A列。
• 把K列最後單元格往上509個數據，填入工作簿名"淺咖啡色"的A列。

根據要求，整理一下思路如下：

1. 把每列的最後500個數據放入數組（數組的賦值）
2. 按照Q2單元格給的文件夾名稱，打開對應文件夾下面對應的工作薄（打開工作薄）
3. 把放入了500個數據的數組，賦值給對應的表格（讀取數組的值）
4. 自動關閉表格（關閉工作薄
5. 重複上述步驟

思路有了，但是也有最大一個難點：如何保證讀取了B列的數據，確定保證能打開“白色”的工作表

先看一下已經寫好的代碼運行結果：

具體代碼如下：

Sub HCH()

'關閉保存時彈出的警告窗口

Application.DisplayAlerts = False

'關閉屏幕刷新

Application.ScreenUpdating = False

'定義參數及數組

Dim i, num

Dim str

Dim arr, brr()

For num = 2 To 11

'提出列結果的最後一列

i = Sheet1.Cells(1, num).End(xlDown).Row

'需要使用的最後500行數據，放入arr數組

arr = Range(Cells(i - 499, num), Cells(i, num))

'文檔的名稱放入數組

brr = Array("白色", "金絲", "銀絲", "咖啡色", "黑金剛", "天藍色", "淺藍色", "橘黃色", "雪牙色", "淺咖啡色")

str = brr(num - 2)

'跟隨for循環打開文檔

Workbooks.Open ThisWorkbook.Path & "" & Range("Q1") & "" & str & ".xlsx"

Sheets(1).Activate

'把需要的數據，進行賦值

Range("A1:A500") = arr

'關閉文件並保存

Workbooks(str & ".xlsx").Close SAVECHANGES:=True

'清空arr數組，為重新賦值做準備

Erase arr

Next

'打開保存時彈出的警告窗口

Application.DisplayAlerts = True

'打開屏幕刷新

Application.ScreenUpdating = True

End Sub

代碼解析：

1.把文檔的名稱全部放入brr數組。

2.ThisWorkbook.Path 表示獲取當前打開文檔的路徑。

3.Workbooks(str & ".xlsx").Close SAVECHANGES:=True 表示關閉後確認。

4.Erase arr 表示清空數組

閱讀更多 浮雲Excel分享 的文章

關鍵字: Excel 指定 職場