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

[µo°Ý] ¤U­Ó¤ë·sÀÉ

¥»©«³Ì«á¥Ñ PJChen ©ó 2020-1-26 22:00 ½s¿è

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

½Ð°Ý­ã¤j,
¦P­ÓÀÉ®×,Sheet¥H1~31©R¦W,¨ä¤¤¤]¦³«D¼Æ¦rªº¤u§@ªí,§Ú»Ý­n¤@­Ó¥i¥H§R°£¤j©ó¤ë©³¤é¤u§@ªíªº¥\¯à(«D¼Æ¦rªº¤u§@ªí¤£§R,¥Ø«e±Æ§Ç,²Ä¤@­Ó¤u§@ªí¬°¤å¦r¤u§@ªí),¦pªG·í¤ë¥¿¦n¬O31¤Ñ,¤]³£¤£¥Î§R°£¤u§@ªí,
µ{¦¡½X«Üªø,§Ú¥uºI¨ú¤@³¡¥÷,¥H¤U³o¥y, ¤@ª½°õ¦æ±o«Ü©Ç,¦sÀɮɬ°2¤ë¥÷¤é´Á,2¤ë¥÷¦³29¤é,¥¦«o¥u§R°£29¡B31ªº¤u§@ªí,§Ú»Ý­n§R°£ªº¬O30¡B31ªº¤u§@ªí,½Ð°Ý¥i¥H«ç»ò­×¥¿µ{¦¡?
Sheets(j).Delete    '§R°£¤j©ó¤ë©³¤éªº¤u§@ªí
  1.     Dim Path As String, myPath As String, File As String, xFile As String, i As String, m As String, xd As Long, j As Long, xJ As Long, k As Long
  2.     i = DateSerial(Year(Date), Month(Date) + 1, 1)  '³]©w¤U­Ó¤ë1¤é
  3.     m = Format(i, "M¤ë") '³]©w¤U­Ó¤ë¥÷
  4.     xd = Format(DateSerial(Year(Date), Month(Date) + 2, 1) - 1, "D")   '¤U­Ó¤ë©³¤éÅܼÆ

  5. With Workbooks.Open(Path & File)
  6.                 For j = 2 To ActiveWorkbook.Sheets.Count  '±q#2¶}©lªº¤u§@ªí¤¤´`Àô
  7.                     ActiveWorkbook.Sheets(j).Activate
  8.                         [A2] = [A2].Value '­È¤Æ
  9.                         [B1] = [B1].Value '­È¤Æ
  10.                         
  11.                         If j > xd Then
  12.                             Sheets(j).Delete    '§R°£¤j©ó¤ë©³¤éªº¤u§@ªí
  13.                         End If
  14.                     Next
  15.                         Sheets("1").Activate
  16.                     For k = 1 To [U1]  '±NU1Àx¦s®æªº­È,§@¬°ÅܼƦs¨ú¦¸¼Æ,¨Ì§Ç©R¦WÀɮצW¨Ã¦sÀÉ
  17.                         [P1] = k   '«ü©wÀx¦s®æªº­È
  18.                         ActiveWorkbook.SaveAs filename:=myPath & [G1] & " _" & m & ".xlsx"  'one by one ¦sÀÉk¦¸
  19.                     Next
  20.                         ActiveWorkbook.Close True   '¦sÀÉ«áÃö³¬ÀÉ®×
  21.             End With
½Æ»s¥N½X

TOP

¥»©«³Ì«á¥Ñ ­ã´£³¡ªL ©ó 2020-2-10 16:16 ½s¿è

Sub TEST()
Dim xPath$, xFile$, i&, k&
Dim Lastday$, mDay%, xBK As Workbook
Lastday = DateSerial(Year(Date), Month(Date) + 2, 0) '¤U­Ó¤ë¤ë©³
mDay = Day(Lastday) '¤U­Ó¤ë¤Ñ¼Æ
Set xBK = Workbooks.Open(xPath & xFile) '¶}±Ò«ü©wÀÉ®×
'-----------------------------------
Application.DisplayAlerts = False
On Error Resume Next
For i = mDay + 1 To 31: xBK.Sheets(i & "").Delete: Next i '§R¤u§@ªí
On Error GoTo 0
Application.DisplayAlerts = True
'-----------------------------------
For i = 1 To mDay
    With xBK.Sheets(i & "")
         .[A2] = .[A2].Value '­È¤Æ
              .[B1] = .[B1].Value '­È¤Æ
    End With
Next i
End Sub

¨ä¥¦»Ý¨D¦Û¦æ¥[¤J~~

===================================

TOP

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

­ã¤j,
2¤ë¤w¸gµLªk´ú¸Õ,3¤ë¤S¬O31¤Ñ,©Ò¥H§Ú´ú¸Õ4¤ë
³o¥y
For i = mDay + 1 To 31: BK.Sheets(i & "").Delete: Next i '§R¤u§@ªí
»P«e­±ªºDim Lastday$, mDay%, xBK As Workbook¤£¦P,µLªk§R°£¤j©ó¤ë©³¤éªº¤u§@ªí,©Ò¥H§Ú§ï¬°
For i = mDay + 1 To 31: xBK.Sheets(i & "").Delete: Next i
§R°£¤j©ó¤ë©³¤éªº¤u§@ªí¥i°õ¦æ,¦ý¤S¦³¨ä¥L¦a¤è¥dÃö,½ÐÀ°¦£¬Ý¤U¬O§_§Ú¦³§Ë¿ùªº»yªk??
  1. Sub EX()
  2. Dim Path$, File$, i&, k&
  3. Dim Lastday$, mDay%, xBK As Workbook, BK As Workbook
  4. Dim myPath$, xFile$, m$, h$
  5. Lastday = DateSerial(Year(Date), Month(Date) + 3, 0) '¤U¤U­Ó¤ë¤ë©³
  6. mDay = Day(Lastday) '¤U­Ó¤ë¤Ñ¼Æ
  7. h = DateSerial(Year(Date), Month(Date) + 2, 1)  '³]©w¤U­Ó¤ë1¤é
  8. m = Format(h, "M¤ë") '³]©w¤U­Ó¤ë¥÷
  9. Application.ScreenUpdating = False  'Ãö³¬«Ì¹õ§ó·s
  10. Application.DisplayAlerts = False   '¤@¯ë´£Äµ¥Ü°T®§Ãö³¬
  11.     Path = "U:\a\1.¤U­Ó¤ë²z³f³æ\"  '¨Ó·½¸ê®Æ§¨
  12.     myPath = "U:\b\"                 '¥t¦s¥Øªº¸ê®Æ§¨

  13.         File = Dir(Path & "*.xlsx")          '¨Ó·½ÀɦW
  14.             Do While File <> ""
  15.                 With Workbooks.Open(Path & File)
  16.                         On Error Resume Next
  17.                         Sheets("1").Activate
  18.                         [A2] = Format(h, "M/D")   '¿é¤J«ü©w¤é´Á,¬°¤U­Ó¤ë1¤é
  19.                         ActiveWorkbook.Save '**¦sÀɤ£Ãö³¬
  20.                 End With

  21. Set xBK = Workbooks.Open(Path & File) '¶}±Ò«ü©wÀÉ®×

  22.             On Error Resume Next
  23.             For i = mDay + 1 To 31: xBK.Sheets(i & "").Delete: Next i '§R¤u§@ªí
  24.             On Error GoTo 0

  25.             For i = 1 To mDay
  26.                 With xBK.Sheets(i & "")
  27.                     .[A2] = .[A2].Value '­È¤Æ
  28.                     .[B1] = .[B1].Value '­È¤Æ
  29.                 End With
  30.             Next i
  31.                 For i = 1 To mDay  '¦b¤u§@ªí¤¤´`Àô
  32.                     With xBK.Sheets(i & "")
  33.                         Sheets("1").Activate
  34.                         For k = 1 To [U1]  '±NU1Àx¦s®æªº­È,§@¬°ÅܼƦs¨ú¦¸¼Æ,¨Ì§Ç©R¦WÀɮצW¨Ã¦sÀÉ
  35.                             [P1] = k   '«ü©wÀx¦s®æªº­È
  36.                             ActiveWorkbook.SaveAs filename:=myPath & [V2] & [G1] & " _" & m & ".xlsx" 'one by one ¦sÀÉk¦¸
  37.                         Next
  38.                             ActiveWorkbook.Close True   '¦sÀÉ«áÃö³¬ÀÉ®×
  39.                     End With
  40.                 Next i
  41.     File = Dir
  42.         Loop
½Æ»s¥N½X

TOP

¦^´_ 13# PJChen

¬õ¦â¦rÅ鬰­×§ï»yªk:
Sheet§R°£¥Ñ¥ª¦V¥k·|³y¦¨²§±`
For i = mDay + 1 To 31: xBK.Sheets(i & "").Delete: Next i '§R¤u§@ªí
§ï¬°¥Ñ¥k¦V¥ª§R°£
For i = 31 To mDay + 1 Step -1: xBK.Sheets(i & "").Delete: Next i

ÂŦâ¦rÅ鬰§R°£
¸Õ¸Õ¬Ý!!

Sub EX()
Dim Path$, File$, i&, k&
Dim Lastday$, mDay%, xBK As Workbook, BK As Workbook
Dim myPath$, xFile$, m$, h$
Lastday = DateSerial(Year(Date), Month(Date) + 3, 0) '¤U¤U­Ó¤ë¤ë©³
mDay = Day(Lastday) '¤U­Ó¤ë¤Ñ¼Æ
h = DateSerial(Year(Date), Month(Date) + 2, 1)  '³]©w¤U­Ó¤ë1¤é
m = Format(h, "M¤ë") '³]©w¤U­Ó¤ë¥÷
Application.ScreenUpdating = False  'Ãö³¬«Ì¹õ§ó·s
Application.DisplayAlerts = False   '¤@¯ë´£Äµ¥Ü°T®§Ãö³¬
    Path = "D:\backup20060523\MDBView\³Â»¶¾Ç¶é\1.¤U­Ó¤ë²z³f³æ_´ú¸Õ\ÀÉ®×\"  '¨Ó·½¸ê®Æ§¨
    myPath = "D:\backup20060523\MDBView\³Â»¶¾Ç¶é\1.¤U­Ó¤ë²z³f³æ_´ú¸Õ\2_¼È\"                '¥t¦s¥Øªº¸ê®Æ§¨

        File = Dir(Path & "*.xlsx")          '¨Ó·½ÀɦW
            Do While File <> ""
                With Workbooks.Open(Path & File)
                        On Error Resume Next
                        Sheets("1").Activate
                        [A2] = Format(h, "M/D")   '¿é¤J«ü©w¤é´Á,¬°¤U­Ó¤ë1¤é
                        ActiveWorkbook.Save '**¦sÀɤ£Ãö³¬
                End With

Set xBK = Workbooks.Open(Path & File) '¶}±Ò«ü©wÀÉ®×

            On Error Resume Next
         '   For i = mDay + 1 To 31: xBK.Sheets(i & "").Delete: Next i '§R¤u§@ªí
            For i = 31 To mDay + 1 Step -1: xBK.Sheets(i & "").Delete: Next i '§R¤u§@ªí
            On Error GoTo 0

            For i = 1 To mDay
                With xBK.Sheets(i & "")
                    .[A2] = .[A2].Value '­È¤Æ
                    .[B1] = .[B1].Value '­È¤Æ
                End With
            Next i
             '   For i = 1 To mDay  '¦b¤u§@ªí¤¤´`Àô
             '       With xBK.Sheets(i & "")
                        Sheets("1").Activate
                        For k = 1 To [U1]  '±NU1Àx¦s®æªº­È,§@¬°ÅܼƦs¨ú¦¸¼Æ,¨Ì§Ç©R¦WÀɮצW¨Ã¦sÀÉ
                            [P1] = k   '«ü©wÀx¦s®æªº­È
                            ActiveWorkbook.SaveAs Filename:=myPath & [V2] & [G1] & " _" & m & ".xlsx" 'one by one ¦sÀÉk¦¸
                        Next
                            ActiveWorkbook.Close True   '¦sÀÉ«áÃö³¬ÀÉ®×
             '       End With
             '   Next i
    File = Dir
        Loop

TOP

¦^´_ 14# jcchiang

i=31
sheets(i).delete = §R°£²Ä31±i¤u§@ªí
sheets(i & "").delete = §R°£¦WºÙ"31"ªº¤u§@ªí, ©Ò¥H§R°£¤è¦V¤£­­

TOP

¦^´_ 14# jcchiang

§ï³o¼Ë¥i¥H¥¿±`¹B§@¤F
ÁÂÁÂ

TOP

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

½Ð°Ý­ã¤j,
For i = mDay + 1 To 31: xBK.Sheets(i & "").Delete: Next i '§R¤u§@ªí
¥i¥H§R°£¤j©ó¤ë©³¤éªº¤u§@ªí
¦ý¥d¦b³o¸ÌµLªk°õ¦æ,¬O¤°»ò°ÝÃD?
                For i = 1 To mDay  '¦b¤u§@ªí¤¤´`Àô
                    With xBK.Sheets(i & "")
                        Sheets("1").Activate
                        For k = 1 To [U1]

TOP

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

¤F¸Ñ,ÁÂÁ­ã¤jªº«ü¾É

TOP

¦^´_ 17# PJChen

¬O¦]¬°©p­n°µFor i = 1 To mDayªºÀɮפw¸gÃö³¬¤F

TOP

¥»©«³Ì«á¥Ñ PJChen ©ó 2020-2-10 18:18 ½s¿è

¦^´_ 15# ­ã´£³¡ªL
¦^´_ 19# jcchiang

«e¤@­Óµ{¦¡µ²§ô«á,§ÚÁÙ­n§@«áÄòªºÀɮ׳B²z,§Ú©µ¥Î¤§«eªº»yªk,¤@¼Ë¬O´ú¸Õ4¤ë¥÷,
¥H¤u§@ªí¤¤ªºSheets("1").Range("A2")ªº¤é´Á(2020/4/1),§ì¤ë©³¤é
§ï¬°³o¼Ë,¦ý¬°¤°»ò¬õ¦â³¡¥÷,¤´µLªk°õ¦æ?
Lastday = DateSerial(Year(BK.Sheets("1").Range("A2")), Month(BK.Sheets("1").Range("A2")), 0) '¤ë©³¤é
mDay = Day(Lastday)
For i = 1 To mDay
With BK.Sheets(i & "")
  1. Sub ¤U­Ó¤ë_²z³f³æ_¥ØªºÀɪíÀY­È¤Æ()
  2. '¤ñµá¦h²z³f³æ
  3. Dim Lastday$, mDay%, BK As Workbook
  4. Dim myPath$, xFile$, i&

  5. Application.ScreenUpdating = False  'Ãö³¬«Ì¹õ§ó·s
  6. Application.DisplayAlerts = False   '¤@¯ë´£Äµ¥Ü°T®§Ãö³¬
  7.     myPath = "U:\b\"                 '¥t¦s¥Øªº¸ê®Æ§¨

  8.     xFile = Dir(myPath & "*.xlsx")          '¥Øªº¸ê®Æ§¨ÀɦW
  9.         Do While xFile <> ""
  10.             Application.DisplayAlerts = False       '¤@¯ë´£Äµ¥Ü°T®§Ãö³¬
  11.                 With Workbooks.Open(myPath & xFile)
  12.                     Set BK = Workbooks.Open(myPath & xFile) '¶}±Ò«ü©wÀÉ®×
  13.                     Lastday = DateSerial(Year(BK.Sheets("1").Range("A2")), Month(BK.Sheets("1").Range("A2")), 0) '¤ë©³¤é
  14.                     mDay = Day(Lastday)
  15.                     For i = 1 To mDay   '¦b¤u§@ªí¤¤´`Àô
  16.                         With BK.Sheets(i & "")
  17.                         .[G1] = .[G1].Value '­È¤Æ
  18.                         .[A1] = .[A1].Value '­È¤Æ
  19.                         End With
  20.                     Next i
  21.                         Sheets("1").Activate
  22.                         Range("P1:V2").ClearContents
  23.                         Sheets("1").Range("G1") = Sheets("2").Range("G1").Value
  24.                         ActiveWorkbook.Close True   '¦sÀÉ«áÃö³¬ÀÉ®×
  25.                 End With
  26.     xFile = Dir
  27.         Loop
  28.                 Application.ScreenUpdating = True   '¥´¶}«Ì¹õ§ó·s

  29. End Sub
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : ·R¤£¬O­n¨D¹ï¤è¡A¦Ó¬O­n¥Ñ¦Û¨­ªº¥I¥X¡C
ªð¦^¦Cªí ¤W¤@¥DÃD