- 帖子
- 2848
- 主題
- 10
- 精華
- 0
- 積分
- 2903
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2026-7-25
|
回復 4# badboy741 - Sub TEST()
- Dim TTL As Worksheet, i%, j%, T1$, T2$, T3$, TT$, U, V, N%, PH$
- On Error Resume Next: Set TTL = Sheets("TOTAL"): On Error GoTo 0
- If TTL Is Nothing Then Set TTL = Sheets.Add: TTL.Name = "TOTAL"
- TTL.Move Sheets(1): TTL.UsedRange.Clear
- PH = ThisWorkbook.Path & "\" '此路徑自行更改
- For i = 2 To Sheets.Count
- T1 = Sheets(i).[Q3]: T2 = Sheets(i).[C3]
- If T1 Like "######" = False Or T2 = "" Then GoTo 101
-
- TTL.[A1] = "'" & T1
- If Dir(PH & T1, vbDirectory) = "" Then MkDir PH & T1
-
- T2 = Replace(Replace(Replace(T2, "-(", "("), " ", "-"), "/", "(") & ") PCS"
- N = N + 1: TTL.Cells(N + 1, 1) = T2
-
- TT = PH & T1 & "\" & T2
- If Dir(TT, vbDirectory) = "" Then MkDir TT
-
- For Each U In Array("25WL", "篩選重測 PCS")
- If Dir(TT & "\" & U, vbDirectory) = "" Then MkDir TT & "\" & U
- Next
-
- For Each U In Array("Burnin ACC after test 25 L-I-V", "Burnin before test 25 L-I-V")
- If Dir(TT & "\" & U, vbDirectory) = "" Then MkDir TT & "\" & U
-
- V = Split("1,65,129,193,257,321,385,449,513,577,641,705,769", ",")
- For j = 1 To UBound(V)
- T3 = TT & "\" & U & "\" & V(j - 1) & "-" & V(j) - 1
- If Dir(T3, vbDirectory) = "" Then MkDir T3
- Next j
- Next
- 101: Next i
- End Sub
複製代碼 |
|