- 帖子
- 6
- 主題
- 3
- 精華
- 0
- 積分
- 9
- 點名
- 0
- 作業系統
- Win 10
- 軟體版本
- office2000
- 閱讀權限
- 10
- 註冊時間
- 2021-1-11
- 最後登錄
- 2021-3-22
|
2#
發表於 2021-1-26 21:41
| 只看該作者
各位前輩
小弟自己摸索出目前可運作的程式碼如下- Dim Arr_ssd, Arr_temp, ReArr_1, ReArr_2, Arr_out As Variant
- Dim a, b, c, i, j, k, rr, cc, x, y As Variant
-
- Application.DisplayAlerts = False
-
- Windows("array-1.xls").Activate
- i = Workbooks("array-1").Sheets("統計表").UsedRange.Rows.Count
- j = Round((i / 25) + 0.5)
- k = 0 'k為判斷執行次數
-
- Worksheets("統計表").Activate
- Arr_ssd = Sheets("統計表").Range([A2], Cells(i, 1).Offset(, 7)).Value
- Arr_out = Sheets("匯出表").Range("A2:I26")
- Dim dd As Range
- Set dd = Sheets("匯出表").Range("A2")
- ReDim Arr_temp(1 To 25, 1 To 9)
-
- ReArr_1 = WorksheetFunction.Transpose(Arr_ssd)
- ReDim Preserve ReArr_1(1 To 9, 1 To 1 + (25 * j))
- ReArr_2 = WorksheetFunction.Transpose(ReArr_1)
-
- x = 1
- y = 1
- rr = 0
-
- For k = 1 To j
- For y = 1 + (rr) To 25 + (rr)
- For x = 1 To 9
- Arr_temp(y - (rr), x) = ReArr_2(y, x)
- Debug.Print Arr_temp(y - (rr), x)
- Next x
- Next y
- rr = rr + 25
- dd.Resize(UBound(Arr_temp, 1), UBound(Arr_temp, 2)).Value = Arr_temp
-
- '輸出表單
- Next k
|
|
