返回列表 上一主題 發帖

[發問] excel vba新增資料夾

  1. Sub TEST()
  2. Dim TTL As Worksheet, i%, T1$, T2$, N%, PH$

  3. On Error Resume Next: Set TTL = Sheets("TOTAL"): On Error GoTo 0
  4. If TTL Is Nothing Then Set TTL = Sheets.Add: TTL.Name = "TOTAL"
  5. TTL.Move Sheets(1): TTL.UsedRange.Clear

  6. PH = ThisWorkbook.Path & "\"

  7. For i = 2 To Sheets.Count
  8.     T1 = Sheets(i).[Q3]: T2 = Sheets(i).[C3]
  9.     If T1 Like "######" = False Or T2 = "" Then GoTo 101
  10.     TTL.[A1] = "'" & T1
  11.     If Dir(PH & T1, vbDirectory) = "" Then MkDir PH & T1
  12.    
  13.     T2 = Replace(Replace(Replace(T2, "-(", "("), "  ", "-"), "/", "(") & ") PCS"
  14.     N = N + 1: TTL.Cells(N + 1, 1) = T2
  15.     If Dir(PH & T1 & "\" & T2, vbDirectory) = "" Then MkDir PH & T1 & "\" & T2
  16. 101: Next i
  17. End Sub
複製代碼

TOP

回復 4# badboy741
  1. Sub TEST()
  2. Dim TTL As Worksheet, i%, j%, T1$, T2$, T3$, TT$, U, V, N%, PH$
  3. On Error Resume Next: Set TTL = Sheets("TOTAL"): On Error GoTo 0
  4. If TTL Is Nothing Then Set TTL = Sheets.Add: TTL.Name = "TOTAL"
  5. TTL.Move Sheets(1): TTL.UsedRange.Clear

  6. PH = ThisWorkbook.Path & "\" '此路徑自行更改

  7. For i = 2 To Sheets.Count
  8.     T1 = Sheets(i).[Q3]: T2 = Sheets(i).[C3]
  9.     If T1 Like "######" = False Or T2 = "" Then GoTo 101
  10.    
  11.     TTL.[A1] = "'" & T1
  12.     If Dir(PH & T1, vbDirectory) = "" Then MkDir PH & T1
  13.    
  14.     T2 = Replace(Replace(Replace(T2, "-(", "("), "  ", "-"), "/", "(") & ") PCS"
  15.     N = N + 1: TTL.Cells(N + 1, 1) = T2
  16.    
  17.     TT = PH & T1 & "\" & T2
  18.     If Dir(TT, vbDirectory) = "" Then MkDir TT
  19.    
  20.     For Each U In Array("25WL", "篩選重測   PCS")
  21.         If Dir(TT & "\" & U, vbDirectory) = "" Then MkDir TT & "\" & U
  22.     Next
  23.    
  24.     For Each U In Array("Burnin ACC after test 25 L-I-V", "Burnin before test 25 L-I-V")
  25.         If Dir(TT & "\" & U, vbDirectory) = "" Then MkDir TT & "\" & U
  26.         
  27.         V = Split("1,65,129,193,257,321,385,449,513,577,641,705,769", ",")
  28.         For j = 1 To UBound(V)
  29.             T3 = TT & "\" & U & "\" & V(j - 1) & "-" & V(j) - 1
  30.             If Dir(T3, vbDirectory) = "" Then MkDir T3
  31.         Next j
  32.     Next
  33. 101: Next i
  34. End Sub
複製代碼

TOP

回復 6# badboy741


最後一段改為:
    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
        
        X = Val(Sheets(i).[L7])
        For j = 1 To X Step 64
            V = j + 63: If V > X Then V = X
            T3 = TT & "\" & U & "\" & j & "-" & V
            If Dir(T3, vbDirectory) = "" Then MkDir T3
        Next j
    Next

TOP

        靜思自在 : 生氣,就是拿別人的過錯來懲罰自己。
返回列表 上一主題