Sub 轉換()
Dim Arr, Brr, i&, j%, R&, T1$, T2$, N&
Arr = Sheets("原始檔案").UsedRange
ReDim Brr(1 To 50000, 1 To 4)
For i = 1 To UBound(Arr)
If Arr(i, 1) = "料件編號" Then R = i: GoTo i01
If Not Arr(i, 4) Like "JM##-#########" Then GoTo i01
For j = 5 To UBound(Arr, 2)
If Val(Arr(i, j)) = 0 Then GoTo j01
N = N + 1
Brr(N, 1) = Arr(i, 1): Brr(N, 2) = Arr(i, 4)
Brr(N, 3) = Arr(R, j): Brr(N, 4) = Arr(i, j)
j01: Next j
i01: Next i
Call 清除: If N = 0 Then Exit Sub
[轉換結果!A2].Resize(N, 4) = Brr
[轉換結果!A1].Resize(N + 1, 4).Name = "My_Data"
End Sub
Sub 清除()
With Sheets("轉換結果")
If .AutoFilterMode Then .AutoFilterMode = False
.UsedRange.Offset(1, 0).EntireRow.Delete
End With
End Sub
Sub 轉換()
Dim Arr, Brr, i&, R&, N&, j%, T1$, T2$
'↑宣告變數:(Arr,Brr)通用型變數,(i,R,N)長整數,j短整數,(T1,T2)字串變數
Arr = Sheets("原始檔案").UsedRange
'↑令Arr變數是裝入 "原始檔案"工作表有使用儲存格值的二維陣列
ReDim Brr(1 To 50000, 1 To 4)
'↑宣告Brr是二維空陣列,縱向索引號(1~500000),橫向索引號(1~4)
For i = 1 To UBound(Arr)
'↑設順迴圈!i從1 到Arr陣列縱向最大索引列號
If Arr(i, 1) = "料件編號" Then R = i: GoTo i01
'↑如果i迴圈列1欄Arr陣列值是 "料件編號"字串?
'True就令R變數同i變數值 (這是要記錄每個段落的工作站名稱所在的列號)
'最後跳到標示 i01位置繼續執行
If Not Arr(i, 4) Like "JM##-#########" Then GoTo i01
'↑如果i迴圈列4欄Arr陣列值不是 "JM##-#########"規則的字串?
'True就跳到標示 i01位置繼續執行
For j = 5 To UBound(Arr, 2)
'↑設順迴圈!j從5 到Arr陣列橫向最大索引欄號
If Val(Arr(i, j)) = 0 Then GoTo j01
'↑如果i迴圈列j迴圈欄Arr陣列值轉成的數值是 0,就跳到標示 j01位置繼續執行
N = N + 1
'↑令N變數累加1 (寫入資料的索引列號)
Brr(N, 1) = Arr(i, 1): Brr(N, 2) = Arr(i, 4)
Brr(N, 3) = Arr(R, j): Brr(N, 4) = Arr(i, j)
'↑令Arr陣列資料 寫入Brr陣列中
j01: Next j
i01: Next i
Call 清除: If N = 0 Then Exit Sub
'↑執行副程式 Sub 清除()
'如果N變數是0 (代表N變數是所宣告的長整數初始值 0),就結束程式執行
[轉換結果!A2].Resize(N, 4) = Brr
'↑將Brr陣列值寫入儲存格中
[轉換結果!A1].Resize(N + 1, 4).Name = "My_Data"
'↑令指定範圍儲存格以 "My_Data" 字串為名,納入名稱中
End Sub
Sub 清除()
With Sheets("轉換結果")
If .AutoFilterMode Then .AutoFilterMode = False
'↑如果有自動篩選功能? True就令篩選功能關閉 https://learn.microsoft.com/zh-t ... heet.autofiltermode
.UsedRange.Offset(1, 0).EntireRow.Delete
'↑令除了標題列以外的已使用儲存格刪除
End With
End Sub
