ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] excel vba·s¼W¸ê®Æ§¨

[µo°Ý] excel vba·s¼W¸ê®Æ§¨

§Ú¦³¤@­ÓÀɮסA¸Ì­±¦³¼Æ­Ósheet¡A»Ý­n¥H¦U­Ósheet¤ºªºC3¬°©R¦W«Ø¥ß¼Æ­Ó¸ê®Æ§¨¡A¦A§â¥¦­Ì¥þ³¡¥á¤J¥HQ3¬°©R¦Wªº¸ê®Æ§¨¤º¡A§Ú°Å°Å¶K¶K«á±o¨ì¤F§Ú­nªº®ÄªG¡A¥i¬O¥¦­Ì¥þ³¡³£¥á¦b®à­±¡A¨Ã¨S¦³¥þ³¡³£³£¤J¥HQ3¬°¦Wªº¸ê®Æ§¨¤º


Sub LL()
    Sheets.Add
    Sheets("Sheet1").Name = "TOTAL"
    Sheets("TOTAL").Move Before:=Sheets(1)
Dim i, j As String
Dim sh As String
    i = 1                                                                                                     'total sheet ±q²Ä¤G¦C¶}©l
For n = 1 To ActiveWorkbook.Sheets.Count                                'Á`¦@¦³´X±isheet
    sh = "N"                                                                                             '¤u§@ªí¦WºÙ
    Worksheets(n).Select                                                                     '¿ï¾Ü¬Y­¶¤u§@ªí
    Value1 = Range("C3").Value                                                        '»Ý·JÁ`ªºÀx¦s®æ­È¤À§O©ñ¤J¦U­ÓÅܼÆ
    Worksheets("TOTAL").Select                                                       '¿ï¾ÜTOTAL  sheet
    Range("A" & i).Value = Value1                                                   '±N¦U­ÓÅܼƭȤÀ§O©ñ¤JÀx¦s®æ¦ì¸m
    i = i + 1                                                                                             '·JÁ`­¶total©¹¤U·s¼W¤@¦C N­¶©ú²Óªí´N¦³N¦C¸ê®Æ
Next
    Cells.Replace What:=" ", Replacement:="-", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="--", Replacement:="-", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="/", Replacement:="(", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="-(", Replacement:="(", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
For i = 2 To n - 1
    Range("A" & i).Value = Range("A" & i).Value & ")  PCS"
Next
    Cells.Replace What:="-)", Replacement:=")", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Sheets("1").Select
        Range("Q3").Copy
    Sheets("TOTAL").Select
        Range("A1").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Dim strPath, strFolderName
Dim objFS, objFloder, objFC
    strPath = "C:\Users\tod210\Desktop\"
    strFolderName = Range("A1").Value
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(strPath)
Set objFC = objFolder.SubFolders
    objFC.Add (strFolderName)

Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim folder As String
    folder = ThisWorkbook.Path & "\"
Dim NX As Long, X As Long, NM As String
    NX = [A65536].End(xlUp).Row
For X = 2 To NX
    NM = Cells(X, 1).Value
If NM = "" Then GoTo nextname
    FSO.CreateFolder (folder & NM)
nextname:
Next
End Sub

061025.rar (13.5 KB)

  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
½Æ»s¥N½X

TOP

¦^´_ 2# ­ã´£³¡ªL


    ·PÁª©¥Dªº¦^ÂСA¥i¬O§ÚÁÙ¬O§â¥¦§ï¦¨¥H¤U
¦]¬°¦¹EXCELÀɬO©ñ¦b©T©w¤@¥x¹q¸£¡A§Ú¥²¶·­n¨ì¨C¥x¹q¸£¥h³]©w¥¨¶°«ö¶s(·s¼W¦¨¦Uexcelªº§Ö±¶«ö¶s)¡A¦A«ü©w¨äÀɮפΥ¨¶°
Â^¨ú1.JPG
2016-3-28 20:25


­ì©lÀɵLªk­×§ï¡A·Ó±zªº³]©w¥¦·|¦A¥»¨­ªºworkbook¥h¼W¥[sheet¡A³o¼Ë¤@¨Ó¥¦·|§ì¨ìªÅ¥Õªºworkbook¥h·s¼W¸ê®Æ§¨¡A¤]´N¤£·|¶]¥ô¦óªF¦è¥X¨Ó¤F


Sub LL()
    Sheets.Add
    Sheets("Sheet1").Name = "TOTAL"
    Sheets("TOTAL").Move Before:=Sheets(1)

Dim TTL As Worksheet, i%, T1$, T2$, N%, PH$
On Error Resume Next: Set TTL = Sheets("TOTAL"): On Error GoTo 0

PH = "C:\Users\tod210\Desktop\"

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
    If Dir(PH & T1 & "\" & T2, vbDirectory) = "" Then MkDir PH & T1 & "\" & T2
101: Next i

ActiveWorkbook.Close False
Application.Quit

End Sub

TOP

¥»©«³Ì«á¥Ñ badboy741 ©ó 2016-3-30 06:03 ½s¿è

¦^´_ 2# ­ã´£³¡ªL


    ½Ð°Ý§Ú¨Ì·Óexcel«Ø¥ß¥X¨Óªº¸ê®Æ§¨©³¤U¦³¤@¼h¡AvbaÁÙ¥i¥H¦A©³¤U¦h·s«Ø¥ß«ü©wÀɦWªº¸ê®Æ§¨¶Ü¡H

¨Ì¹Ï¤ù©Ò¥Ü063027©³¤U·|¦³¼Æ­Ó¸ê®Æ§¨¬°­ì¥»µ{¦¡½X©Ò·s«Ø¥X¨Ó
Â^¨ú3.JPG
2016-3-30 06:00

§Ú¥²¶·­n¦A¦U­Ó¸ê®Æ§¨¤º¦A¥h·s¼W4­ÓÀɦW¬°©T©wªº¸ê®Æ§¨
¤À§O¬°
25WL
Burnin before test 25 L-I-V
Burnin after test 25 L-I-V
¿z¿ï­«´ú
³o¨ä¤¤"Burnin before test 25 L-I-V"¡B"Burnin after test 25 L-I-V"©³¤U¦U¥²¶·¦³12­Ó©T©wÀɦWªºªÅ¸ê®Æ§¨
1-64
65-128
129-192
193-256
257-320
321-384
385-448
449-512
513-576
577-640
641-704
705-768

¸Ô²Óµ²ªG¦pªþ¥ó
063027.rar (18.4 KB)

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", "¿z¿ï­«´ú   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
½Æ»s¥N½X

TOP

¦^´_ 5# ­ã´£³¡ªL


    Dear ª©¤j
¨s¤W­zµ{¦¡¥Ø«e¥i¶¶§Q¨Ï¥Î¡A¦ý¸ê®Æ§¨¤º1-64,65-128,129-192....©Ò«Ø¥ß¸ê®Æ§¨¬°©T©w¡A¦¹µ{¦¡¥i§_¥[¤JÅܼơAÅý¦o¦Û¦æ§PÂ_¼Æ¶q
¨Ò¦p§Úªºsheets("1").range("L7")¼Æ¶q¬°382¡AÅý¥¦«Ø¥ß¨ì1-64,65-128,129-192,193-256,257-320,321-384
                sheets("2").range("L7")¼Æ¶q¬°21¡AÅý¥¦«Ø¥ß¨ì1-21¡A¤£­n¨C­Ó³£«Ø¥ß12­Ó¸ê®Æ§¨¨ì768

aaa.jpg
2016-4-9 02:45




063027.rar (208.7 KB)

TOP

¦^´_ 6# badboy741


³Ì«á¤@¬q§ï¬°¡G
    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

        ÀR«ä¦Û¦b : ÀR§¤±`®¦¤v¹L¡B¶¢½Í²ö½×¤H«D¡C
ªð¦^¦Cªí ¤W¤@¥DÃD