- 帖子
- 163
- 主題
- 1
- 精華
- 0
- 積分
- 170
- 點名
- 0
- 作業系統
- Window 7
- 軟體版本
- Office 2007
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2010-9-5
- 最後登錄
- 2022-7-20
|
3#
發表於 2019-5-22 14:11
| 只看該作者
回復 1# iceandy6150
請參考- Private Sub CommandButton1_Click()
- Dim arr
- Dim brr()
- Dim d As Object
- Set d = CreateObject("Scripting.Dictionary")
- Application.ScreenUpdating = False
- ar = Array("資料.xlsx", "尺寸.xlsx")
- For Each book In ar
- Workbooks.Open ThisWorkbook.Path & "\" & book
- arr = ActiveSheet.[A1].CurrentRegion
- ActiveWorkbook.Close 0
- For i = 2 To UBound(arr)
- For j = 2 To UBound(arr, 2)
- d(arr(i, 1) & arr(1, j)) = arr(i, j)
- Next j
- Next i
- Next book
- arr = ActiveSheet.[A1].CurrentRegion
- ReDim brr(1 To UBound(arr) - 1, 1 To UBound(arr, 2) - 1)
- For i = 2 To UBound(arr)
- For j = 2 To UBound(arr, 2)
- brr(i - 1, j - 1) = d(arr(i, 1) & arr(1, j))
- Next j
- Next i
- [B2].Resize(UBound(brr), UBound(brr, 2)) = brr
- Application.ScreenUpdating = True
- Erase brr
- Set d = Nothing
- arr = ""
- End Sub
|
|
