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

[µo°Ý] VBA­×§ï : ½Æ»s¦³¨ç¼Æªº¤u§@ªí¡A¨Ã¥t¦s¨ì·sªº¤u§@ï

¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-6-24 00:50 ½s¿è

¦^´_ 1# edmondsforum

¨SÀÉ®×´ú¸Õ........¥u¯à¬Ý§Aªºµ{¦¡¦b¸£®ü¤¤ºt½m

¤£¹L½T¹êÅý§Ú¬Ý¨ì°ÝÃD¡A§A¤u§@ªícopyªº®É­Ô ÁÙ¬O¦³¤½¦¡ªº

©Ò¥H­n½Õ´«¶¶§Ç¡A¥ý¼g


With xName.UsedRange
     .Value = .Value
End With


¦A¼g

xName.Copy

¥h±¼¤½¦¡¦A½Æ»s¤u§@ªí°ò¥»¤W´N¨S°ÝÃD¤F


§Ú¸É¥R»¡©ú¤@¤U
°²³]§Ú½Æ»s¦¨¥\«á,¥B¥t¦s·sªºÀÉ®×
¨º»ò­ì¥ýªºÀɮפ£¬O·|²£¥Í¤u§@ªí¶Ü
¥L¯à²¾°£¶Ü¡H

¦b Application.ScreenUpdating = True ³o¦æµ{¦¡«e­± ¼g§R°£¤u§@ªí¡AÀ³¸Ó´N¥i¥H¤F

xName.delete

¦pªG°õ¦æ¦³¿ùªº¸Ü¡A½Ðªþ¤WÀɮרӬݬݧa¡A§Ú´X¥G¬Oª¼¼gªº
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-6-24 01:13 ½s¿è

¦^´_ 3# n7822123


ÁקK§A¬Ý¤£À´§Ú¦bÁ¿¤°»ò¡A²£¥ÍÂû¦PÀnÁ¿¡AÁÙ¬O§ïµ¹§A¡A§A´ú¸Õ¬Ý¬Ý

Sub test3()

    Dim I As Long
    Dim xWeek As Integer
    Dim xS As Worksheet
    Dim xPH$
    xPH = ThisWorkbook.Path & "\"
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set xS = Sheets("¶g³øªí")
    xWeek = InputBox("½Ð¿é¤J²Ä""?""¶g")
    xS.Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "²Ä" & xWeek & "¶g"
    Set xName = ActiveSheet
    With xName.UsedRange
        .Value = .Value
    End With
    xName.Copy
   With ActiveWorkbook
       ActiveSheet.Name = "²Ä" & xWeek & "¶g"
      .SaveAs xPH & "²Ä" & xWeek & "¶g.xlsx", CreateBackup:=False
      .Close
   End With
   xName.Delete
   Application.ScreenUpdating = True
   
End Sub
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-6-24 12:04 ½s¿è

¦^´_ 5# edmondsforum


xName ¬O±q¶g³øªí½Æ»s¥X¨Óªº¤u§@ªí (Ex:²Ä¤T¶g)

¥ý§âxName ¥h¤½¦¡ ¦A½Æ»s¥X¬¡­¶Ã¯¡A´N¤£·|¦³¤½¦¡

³Ì«á¦A§âxName§R±¼¡A´N¬O§Ú3¼Ó»P4¼Ó ¸ò§AÁ¿ªº¼gªk

·Pı§A5¼Ó»P7¼Óªº¦^µª¡A³s¸Õ§Úªºµ{¦¡³£¨S¦³À|¸Õ¹L

¨º§ÚÁÙ¦³¥²­n¦A¦^µª¤U¥h¶Ü?
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-6-25 01:29 ½s¿è

¦^´_ 10# edmondsforum


1.¬O¤£¬O±o·s¼W¬Y­Óµ{¦¡½X¡A¤~¯àÅý­ì¥»ªº"¶g³øªí"¤£·|²£¥Í #N/A ©O

§ÚªºExcelª©¥»¬Oªº2007ª©¡A¨S¦³IFS¨ç¼Æ
©Ò¥H¤u§@¶i«×ªí®æªºG3Äæ¦ì§Ú¬Ý¨ìªº¬O¿ù»~­È
³s±a¼vÅT'¤u§@¶i«×'ªºF¾ãÄæ¡B'¶g³øªí'ªºF1¡BF1¡BH1¡BD4¡BD5¬Ý¨ìªº³£¬O¿ù»~­È
©Ò¥H³o³¡¤À§Ú¨S¿ìªkÀ°§AÀˬd¨ç¼Æªº¥¿½T©Ê


2.¥t¦sªºÀɮצWºÙ¡A¥i¤£¥i¥H®Ú¾Ú¥Lªº¤é´Á ¥Ø«eªº¶g¼Æ ©M¤é´Á©R¦W©O?
   ¨Ò¦p¡A²Ä¤T¶g  ¡A¤é´Á¬O ¡G¦Û¥Á°ê 109 ¦~ 3 ¤ë 5 ¤é ¦Ü¥Á°ê 109 ¦~ 3 ¤ë 11 ¤é (¥H¶g­p)
   ÀɮצW´N·|Åã¥Ü¡G1090305~1090311(²Ä¤T¶g).xlsx  
   ³Æµù¡A¨º­Ó109¦~03¤ë05¤é¬O¦bF1  ¡A 109¦~03¤ë11¤é ¬O¦bH1

¦P¬°¤W­±°ÝÃD¡A¨S¦³IFS¨ç¼Æ¡A§Ú¬Ý¨ìªºF1»PH1¬O¿ù»~­È¡A
§Ú¦Û¤v¼g­Ó¤é´Á°Ï¶¡¡A§A¦A¦Û¤v§ï¦¨§A­nªºÀɦW


3.°²¦pÀs¤j¦¨¥\¼g¥X¡A§å¶qªº¡A¯àÀ°§Ú¤À§O¼g¥X¥t¦sªº®É­Ô ¨âºØµ²ªG¶Ü?
   °²³]¿é¤J5
   Aµ²ªG¡G¤À§O²£¥Í5­ÓÀɮסC( ²Ä1¶g.XLSX ²Ä2¶g.XLSX  ²Ä3¶g.XLSX  ²Ä4¶g.XLSX  ²Ä5¶g.XLSX)
   Bµ²ªG¡G¤@­ÓÀɮסC(²Ä1~5¶g.XLSX) ¸ÌÀY¦³5­Ó¤u§@ªí

³o³¡¤À¤w§¹¦¨¡A¨S¤°»ò°ÝÃD¡A¬°¤F¤è«K§A¾\Ū¡AAµ²ªG»PBµ²ªG§Ú¤À¬q¼g  



¥H¤U¬Oµ{¦¡³¡¤À

Sub test0624()
Dim xWeek As Integer
Dim xS As Worksheet
Dim xPH$
Dim ¦~¥÷ As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual          '°±¥Î¦Û°Ê­«ºâ  
¦~¥÷ = 2020     '§PÂ_¨C¶gªº°_©l¡B¨C¶gªºµ²§ô¤é´Á¥Î
xPH = ThisWorkbook.Path & "\"
On Error Resume Next
Set xS = Sheets("¶g³øªí")
xWeek = InputBox("½Ð¿é¤J²Ä""?""¶g")
xlsName = xPH & "²Ä1~" & xWeek & "¶g.xlsx"
'Bµ²ªG¡G¤@­ÓÀɮסC(²Ä1~5¶g.XLSX) ¸ÌÀY¦³5­Ó¤u§@ªí
With Workbooks.Add
  sh_Cnt = .Sheets.Count
  For sh = 1 To xWeek
    xS.Activate
    xS.Copy After:=Sheets(Sheets.Count)
    Set xName = ActiveSheet
    ActiveSheet.Name = "²Ä" & sh & "¶g"
    With xName.UsedRange
        .Calculate
        .Value = .Value
    End With
    xName.Copy After:=.Sheets(.Sheets.Count)   'ª`Sheets«e­±¦³ "." ¬O½Æ»s¨ì·sªº¬¡­¶Ã¯
    xName.Delete
  Next sh
  '§R°£­ì¥»ªÅ¥Õªí®æ
  For sh = 1 To sh_Cnt: .Sheets(1).Delete: Next
  '¦sÀÉÃö³¬
  .SaveAs xlsName
  .Close True
End With         
'Aµ²ªG¡G¤À§O²£¥Í5­ÓÀɮסC( ²Ä1¶g.XLSX ²Ä2¶g.XLSX  ²Ä3¶g.XLSX  ²Ä4¶g.XLSX  ²Ä5¶g.XLSX)
'³o¬q°ò¥»¤W¥i¤w»P¤W­±¨º¬q¦X¨Ö¼g¡A¦ýµ{¦¡·|¤£¦n¾\Ū¡A¬°¤FÅý§A¬ÝÀ´¡A¥ý©î¶}¼gµ¹§A
'¦]¬°§Úªº¶g³øªíF1 »P G1 ³£¬O¿ù»~­È¡AÀɦWªº¤é´Á§Ú¥ý¦Û¤v©w¸q¡A§A¦A¦Û¤v­×§ï!
With Workbooks.Open(xlsName)
  For sh = 1 To .Sheets.Count
    Strday = Format(¶g©l¤é(¦~¥÷, sh), "emmdd")              '§Q¥Î¦Û©w¨ç¼Æ§ì¸Ó¶g¦¸ªº°_¨Ï¤é´Á(ªüÀsTest¥Î)
    Endday = Format(¶g©l¤é(¦~¥÷, sh) + 6, "emmdd")     '§Q¥Î¦Û©w¨ç¼Æ§ì¸Ó¶g¦¸ªºµ²§ô¤é´Á(ªüÀsTest¥Î)
    'Strday = .Sheets(sh).[F1]                                                '§Aªº¤é´Á¶}©l¡A½Ð¦Û¦æ¥´¶}´ú¸Õ
    'Endday = .Sheets(sh).[H1]                                             '§Aªº¤é´Áµ²§ô¡A½Ð¦Û¦æ¥´¶}´ú¸Õ
    xlsName = "(" & .Sheets(sh).Name & ").xlsx"
    xlsName = xPH & Strday & "~" & Endday & xlsName
    .Sheets(sh).Copy
    ActiveWorkbook.SaveAs xlsName
    ActiveWorkbook.Close True
  Next
  .Close False
End With
Set xS = Nothing
Set xName = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic     '±Ò¥Î¦Û°Ê­«ºâ  
End Sub

³o¬q°Æ¨ç¼Æ¬O§Ú¦Û¤v©wªº¡A¦]¬°§Ú¬Ý¨ìªºF1¡BG1¬O¿ù»~­È¡A
©Ò¥H§A§âÀɦW§ï±¼¤§«á¡A³o¬q°Æ¨ç¼Æ¬å±¼¤]¨SÃö«Y


Function ¶g©l¤é(ByVal ¦è¤¸ As Integer, ByVal ¶g¦¸ As Integer) As Date
Dim Day1 As Date, ¶g©l1 As Date
Day1 = DateSerial(2020, 1, 1)
¶g©l1 = Day1 - Weekday(Day1) + 1
Dayadd = (¶g¦¸ - 1) * 7
¶g©l¤é = ¶g©l1 + Dayadd
End Function



Àɮצp¤U¡A¤è«Kª©Excelªº¤H¤]¥i¥H¥´¶}¨Ó¬Ý¡A§Ú¦s2­ÓÀÉ®×(·sª© & ª©)
©ú¤Ñ¤@¾ã¤Ñ­n¥X¥hª±¡A¦pªGÁÙ¦³¥ô¦ó°ÝÃD¡A¥u¯àµ¥¬Ý¬Ý¨ä¥L¤H¦^ÂФF¡A
§Ú³Ì§Ö6/26±ß¤W¤~¯à¦^ÂÐ


Test-0625.rar (424.62 KB)
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-6-25 07:48 ½s¿è

¦^´_ 12# edmondsforum

¥Xªù«e¬Ý¤F¤@¤U¡A§A¦n¹³­n¤À¨â­Óµ{§Ç¡A¥Î¨â­Ó«ö¶s±±¨î

©Ò¥H§Ú§âµ{¦¡¤À¶}¦p¤U

²Ä¤@­Óµ{§Ç (²£¥Í¦h­ÓÀÉ®×)


Sub Create01() '§å¶q½Æ»s'
Dim xS As Worksheet, xName As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual          '°±¥Î¦Û°Ê­«ºâ
xPH$ = ThisWorkbook.Path & "\"
Set xS = Sheets("¶g³øªí")
xWeek% = InputBox("½Ð¿é¤J²Ä1¶g¡ã²Ä""?""¶g")
'Aµ²ªG¡G¤À§O²£¥Í5­ÓÀɮסC( ²Ä1¶g.XLSX ²Ä2¶g.XLSX  ²Ä3¶g.XLSX  ²Ä4¶g.XLSX  ²Ä5¶g.XLSX)
For i = 1 To xWeek
    xS.Copy After:=Sheets(Sheets.Count)
    Set xName = ActiveSheet
    xName.Name = "²Ä" & i & "¶g"
    With xName.UsedRange
        .Calculate                        '­«ºâ
        .Value = .Value
    End With
    xName.Copy
    With ActiveWorkbook
        .SaveAs xPH & "²Ä" & i & "¶g.xlsx", CreateBackup:=False
        .Close True
    End With
    xName.Delete
    Set xName = Nothing
Next
Set xS = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic     '±Ò¥Î¦Û°Ê­«ºâ
End Sub



²Ä¤G­Óµ{§Ç (²£¥Í1­ÓÀɮסA¦h¤u§@ªí)

Sub Create02()   '¿W¥ß½Æ»s'
Dim xS As Worksheet, xName As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual          '°±¥Î¦Û°Ê­«ºâ
xPH$ = ThisWorkbook.Path & "\"
Set xS = Sheets("¶g³øªí")
xWeek% = InputBox("½Ð¿é¤J²Ä""?""¶g")
xlsName$ = xPH & "²Ä1~" & xWeek & "¶g.xlsx"  
'Bµ²ªG¡G¤@­ÓÀɮסC(²Ä1~5¶g.XLSX) ¸ÌÀY¦³5­Ó¤u§@ªí
With Workbooks.Add
    sh_Cnt = .Sheets.Count
    For sh = 1 To xWeek
        xS.Activate
        xS.Copy After:=Sheets(Sheets.Count)
        Set xName = ActiveSheet
        xName.Name = "²Ä" & sh & "¶g"
        With xName.UsedRange
            .Calculate       '­«ºâ
            .Value = .Value
        End With
        xName.Copy After:=.Sheets(.Sheets.Count)   'ª`Sheets«e­±¦³ "." ¬O½Æ»s¨ì·sªº¬¡­¶Ã¯
        xName.Delete
        Set xName = Nothing
    Next sh
    '§R°£­ì¥»ªÅ¥Õªí®æ
    For sh = 1 To sh_Cnt: .Sheets(1).Delete: Next
    '¦sÀÉÃö³¬
    .SaveAs xlsName
    .Close True
End With        
Set xS = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic     '±Ò¥Î¦Û°Ê­«ºâ
End Sub


§Aªº¤u§@ªí¨ç¼Æ¹Bºâ¶q¤Ó¤j........«Ü®e©ö¦º·í

©Ò¥H§Ú°õ¦æµ{¦¡¹Lµ{¤¤§â¨ç¼Æ¦Û°Ê­«ºâÃö³¬

«Øij§A½G¨­¤@¤U¡A´î¤Ö¨ç¼Æ­pºâ¶q

¥Xªù¤F¡AÙTÙT
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-6-30 02:57 ½s¿è

¦^´_ 16# edmondsforum


¦pªG¯Â¤å¦r¥i¥H¡A¤½¦¡¤£¦æ¡A¨º¦]¸Ó¬O¤Ö­ÓÄݩʦӤw

¦]¬°¹q¸£¤£ª¾¹D§A¬O­n¥Î ¤½¦¡ ·íÀɦW ÁÙ¬O ¤½¦¡ªº ­È ·íÀɦW

§ÚÁÙ¨S´ú¡A­nºÎ¤F¡A§AªºÀÉ®×¥ú¬O¶}°_¨Ó´N­n¦n¤[~

§Ú©ú¤Ñ§ä®É¶¡¸Õ¡A§A¤]¥i¥H¥ý´ú¬Ý¬Ý¡A¬O¤£¬O¦h­Ó".Value"

´N¨S°ÝÃD¤F¡Aµ{¦¡¦p¤U



Strday = .Sheets(sh).[F1].Value                                                '§Aªº¤é´Á¶}©l¡A½Ð¦Û¦æ¥´¶}´ú¸Õ
Endday = .Sheets(sh).[H1].Value                                             '§Aªº¤é´Áµ²§ô¡A½Ð¦Û¦æ¥´¶}´ú¸Õ


µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-6-30 03:31 ½s¿è

¦^´_ 16# edmondsforum

­è­è´ú¤@¤U¡Aµo²{­ì¦]¤F~~

ÀɮצWºÙ¤£¯à¥]§t "/" ¦r¤¸¡A¦Ó§AªºF1¡BG1ªºÀx¦s®æ®æ¦¡ ¬O "e/m/d"

©Ò¥H­×§ï¤@¤U¿é¥XÀɦWªº¤é´Á®æ¦¡´N¨S°ÝÃD¤F~~(Àx¦s®æ®æ¦¡¤£¥Î§ï)

¸ò.Value¨SÃö«Y¡AªGµM¦³¨ÇªF¦èÁÙ¬O­nÀÉ®×´ú¤~ª¾¹D°ÝÃD!

¦pªG¬O¤§«eªºÀÉ®×F1¡BG1¦b§Ú¬Ý¨Ó¬O¿ù»~­È¡A¨º§Ú´N§ó¤£·|µo²{³o°ÝÃD¤F~~

©Ò¥H§A­Ìµo°Ý¤@©w­nªþ¤WÀɮתü~~¤£µM¦^µªªÌ´N¸ò½M¤lºN¶H¨S¨â¼Ë



Strday = Format(.Sheets(sh).[F1], "emmdd")          '§Aªº¤é´Á¶}©l [F1]
Endday = Format(.Sheets(sh).[H1], "emmdd")        '§Aªº¤é´Áµ²§ô [H1]


Test-0630.rar (253.47 KB)
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-6-30 12:07 ½s¿è

¦^´_ 19# edmondsforum


­n§ïµ{¦¡­n¬Ý±oÀ´«e«áªºµ{¦¡¦A§ï............

µ{¦¡«e«á¬O¦³ÃöÁpªº¡A¦pªG¤£»Ý­nµ²ªGB

¤£¥Î¼g¨º»ò½ÆÂø¡Aª½±µ½Æ»s¤u§@ªí¥t¦s¬¡­¶Ã¯´N¦n¤F~

ª½±µÂ²¤Æµ{¦¡µ¹§A


Sub test0630_1()
Dim xWeek As Integer
Dim xPH$
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual          '°±¥Î¦Û°Ê­«ºâ
xPH = ThisWorkbook.Path & "\"
xWeek = InputBox("½Ð¿é¤J²Ä""?""¶g")
  For sh = 1 To xWeek
    Sheets("¶g³øªí").Copy
    With ActiveSheet
      .Name = "²Ä" & sh & "¶g"
      Strday = Format(.[I1])
      Endday = Format(.[K1])
      With .UsedRange
          .Calculate
          .Value = .Value
      End With
      xlsName = xPH & Strday & "~" & Endday & "(" & .Name & ").xlsx"      '½Ð°Ý¬°¤°»ò»Ý­n³o¦ê©O? -§ì¤u§@ªí "(²ÄX¶g)" ·í°µÀɦW
      .Parent.SaveAs xlsName
      .Parent.Close True
    End With
  Next sh
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic     '±Ò¥Î¦Û°Ê­«ºâ
End Sub
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

        ÀR«ä¦Û¦b : ºÉ¦h¤Ö¥»¥÷¡A´N±o¦h¤Ö¥»¨Æ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD