[µo°Ý] EXCEL½Ð¯q¡A¶}±Ò¯S©w¸ê®Æ§¨¤º¡A¤£¯S©wÀɦWªº.xlsxÀÉ®×

zz0660

¦p¦ó¨Ï¥ÎVBA°µ¤@­Ó«ö¶s¡A«ö¤@¤U«ö¶s¡A´N¯à¶}±Ò¤£¯S©w¦WºÙªºÀɮשO?

¸ê®Æ§¨¸ô®|¦p¤U¡õ
D:\AA\BB\CC\DD
ÀɮצWºÙ¦p¤U¡õ
L-M AA R S L(XXX0001)20210820-20210823.xlsx
L-M AA R S L(XXX0002)20210824-20210827.xlsx
L-M AA R S L(XXX0002)20210828-20210831.xlsx

°²³]A: ¤µ¤Ñ¤é´Á¬O2021/08/22¡A¨º»ò§Ú·Q¶}±ÒL-M AA R S L(XXX0001)20210820-20210823.xlsxªºÀɮסC

°²³]B: ¤µ¤Ñ¤é´Á¬O2021/08/29¡A¨º»ò§Ú·Q¶}±ÒL-M AA R S L(XXX0002)20210828-20210831.xlsxªºÀɮסC

½Ð°Ý¦U¦ì¤j¤j¡A¸Ó¦p¦ó¼gVBA¨Ó¶}±Ò?
¤w¨Æ¥ýª¦¹L¤å¡A³£¨S¦³·Q­nªº¤è¦¡¡C

½Ð¦U¦ì¨ó§U¡AÁÂÁÂ!

samwang

¦^´_ 1# zz0660

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub ¿ï¾ÜÀÉ®×¥i½Æ¿ï()
With Application.FileDialog(msoFileDialogOpen)
    .InitialFileName = "D:\"
    .AllowMultiSelect = True
    .Show
    fc = .SelectedItems.Count: If fc = 0 Then Exit Sub
    For x = 1 To fc
        FPath = .SelectedItems(x)
        Set WB = Workbooks.Open(FPath)
        With WB.Sheets(1)
            '»Ý¨Dµ{¦¡
            
        End With
        WB.Close
    Next
End With
End Sub

zz0660

¦^´_ 2# samwang
±z¦n¡A·PÁ±zªº¦^µª¡C
¥Ø«e´ú¸Õµ²ªG¡A·|¥X²{¶}±ÒÀÉ®×µøµ¡¡A¦ý¿ï¾ÜÀɮ׫á¡AµLªk¶¶§Q¶}±ÒÀɮסA¦p¤U¹Ï¡C

¤U¸ü (28.75 KB)

2021-8-23 13:10

¦³¨S¦³¿ìªk¡A·|Åýµ{¦¡¦Û°Ê§PÂ_¶}±Ò¤é´Á¡C
L-M AA R S L(XXX0001)20210820-20210823.xlsx

©T©wÀɦWL-M AA R S L¡A·|¤£©w®ÉÅܧóªºÀɦW(XXX0001)20210820-20210823¡C
¤£©w®ÉÅܧóªºÀɦW½d¨Ò
½d¨ÒA: (XXX0002)20210824-20210827
½d¨ÒB: (XXX0003)20210828-20210831

°²³]¤é´Á¤µ¤Ñ¤é´Á2021/08/22¡Aµ{¦¡¯à¤£¯à¶}±Ò20210820-20210823ªº³o­ÓÀÉ®×?

³Â·Ð±z¤F¡AÁÂÁÂ!

samwang

¦^´_ 3# zz0660

¸ê®Æ§¨¸ô®|¦p¤UD:\AA\BB\CC\DD
°²³]¤é´Á¤µ¤Ñ¤é´Á2021/08/22¡Aµ{¦¡¯à¤£¯à¶}±Ò20210820-20210823ªº³o­ÓÀÉ®×?
>> ½Ð¦A´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

Sub test()
Dim Arr(), T$, d$, d1$, d2$, xY$, xM$, xD$
T = Date
Set fs = CreateObject("Scripting.FileSystemObject")
a = "D:\AA\BB\CC\DD"
Set f = fs.GetFolder(a)
Set fc = f.Files
For Each f1 In fc
    d = Split(Split(f1.Name, ")")(1), "-")(0)
    xY = Left(d, 4): xM = Mid(d, 5, 2): xD = Right(d, 2)
    d1 = DateSerial(xY, xM, xD)
    d = Split(Split(Split(f1.Name, ")")(1), "-")(1), ".")(0)
    xY = Left(d, 4): xM = Mid(d, 5, 2): xD = Right(d, 2)
    d2 = DateSerial(xY, xM, xD)
    If T >= d1 And T <= d2 Then
        ReDim Preserve Arr(n)
        Arr(n) = f1.Path
        n = n + 1
    End If
Next

If n > 0 Then
For i = 0 To n - 1
    Set WB = Workbooks.Open(Arr(i))
    '¥Dµ{¦¡»Ý¨D
   
    WB.Close
Next
End If
End Sub

zz0660

¦^´_ 4# samwang
·PÁ±z¨ó§U³B²z¡A¥Ø«e´ú¸Õµ²ªG¡A¨S¿ìªk¶}±ÒÀɮסAÂIÀ»«ö¶s·|°{¤@¤U¡A´N¨S¤ÏÀ³¡C
¦p¤U¹Ï¡C

¤U¸ü (50.16 KB)

2021-8-23 15:54

§Ú¬O±Nµ{¦¡©ñ¦b¥ª¤è«ö¶s¡C

samwang

¦^´_ 5# zz0660

ÂIÀ»«ö¶s·|°{¤@¤U¡A´N¨S¤ÏÀ³
>> µ{¦¡¶}±ÒÀɮ׫á´N·|ª½±µÃö³¬¡A¦]¬°¨S¦³«áÄò°Ê§@(¨S¦³¥Dµ{¦¡»Ý¨D)¡A©Ò¥H¥u¦³°{¤@¤U¡A
§Ú´ú¸Õ¨S°ÝÃD¦pªþ¥ó¡AÁÂÁÂ

zz0660

¦^´_ 6# samwang

·PÁ samwang ¤j¤j¨ó§U³B²z°ÝÃD¡A¤w¸g¬O§Ú·Q­nªº¼Ë¤l¤F¡AÁÂÁ±z¡C

±z´£¨Ñªºµ{¦¡¦p¤U¡õ

Sub test()
Dim Arr(), T$, d$, d1$, d2$, xY$, xM$, xD$
T = Date
Set fs = CreateObject("Scripting.FileSystemObject")
a = "D:\AA\BB\CC\DD"
Set f = fs.GetFolder(a)
Set fc = f.Files
For Each f1 In fc
    d = Split(Split(f1.Name, ")")(1), "-")(0)
    xY = Left(d, 4): xM = Mid(d, 5, 2): xD = Right(d, 2)
    d1 = DateSerial(xY, xM, xD)
    d = Split(Split(Split(f1.Name, ")")(1), "-")(1), ".")(0)
    xY = Left(d, 4): xM = Mid(d, 5, 2): xD = Right(d, 2)
    d2 = DateSerial(xY, xM, xD)
    If T >= d1 And T <= d2 Then
        ReDim Preserve Arr(n)
        Arr(n) = f1.Path
        n = n + 1
    End If
Next

If n > 0 Then
For i = 0 To n - 1
    Set WB = Workbooks.Open(Arr(i))
    '¥Dµ{¦¡»Ý¨D
   
    WB.Close    ¡ö ±N³o¬q²¾°£¡A´N¬O§Ú­nªº¼Ë¤l¡C
Next
End If
End Sub

¦A¦¸·PÁ±z¡A¤@ª½¥H¨Óªº¨ó§U³B²z°ÝÃD¡AÁÂÁÂ!

zz0660

¦^´_ 4# samwang

±z¦n¡A§Ú¨Ï¥Î¦¹¬qµ{¦¡½X¡õ
Sub test()
Dim Arr(), T$, d$, d1$, d2$, xY$, xM$, xD$
T = Date
Set fs = CreateObject("Scripting.FileSystemObject")
a = "D:\AA\BB\CC\DD"
Set f = fs.GetFolder(a)
Set fc = f.Files
For Each f1 In fc
    d = Split(Split(f1.Name, ")")(1), "-")(0)
    xY = Left(d, 4): xM = Mid(d, 5, 2): xD = Right(d, 2)
    d1 = DateSerial(xY, xM, xD)
    d = Split(Split(Split(f1.Name, ")")(1), "-")(1), ".")(0)
    xY = Left(d, 4): xM = Mid(d, 5, 2): xD = Right(d, 2)
    d2 = DateSerial(xY, xM, xD)
    If T >= d1 And T <= d2 Then
        ReDim Preserve Arr(n)
        Arr(n) = f1.Path
        n = n + 1
    End If
Next

If n > 0 Then
For i = 0 To n - 1
    Set WB = Workbooks.Open(Arr(i))
    '¥Dµ{¦¡»Ý¨D
  
Next
End If
End Sub

¤µ¤Ñ§Ú¦b D:\AA\BB\CC\DD ¸ô®|¤U¤S·s¼W ¤£¦PÀɦWªºÀɮסA´N·|¥X²{°ÝÃD¡C
¦p¤U¹Ï¡õ

¤U¸ü (8.63 KB)

2021-9-5 14:09

§Ú·s¼WªºÀɮפΦWºÙ¦p¤U¹Ï

¤U¸ü (19.08 KB)

2021-9-5 14:13

·s¼WÀɮצWºÙ¦p¤U

20170831-½Ð¨ó§U¥´¤WÀɮצWºÙ-Xjl
ZXZ0099X0.0-³¡«~¦W¥U²M³æ-2019
ZXZ0099X1.0-20190101¼Ð¥Ü


¥D­n¬O«ü°w¹ï¥H¤UÀɦW¶}±Ò

¤U¸ü (18.11 KB)

2021-9-5 14:15

¤£·|¦]¬°¨ä¥LÀɦW¦Ó¶}±Ò¤£¤FÀɮסC

¥Ø«e­Ó¤H»{¬°¥i¯à¬OSplit¡A³oÃ䪺°ÝÃD§a?

ÁٽФj¤j¨ó§U¡AÁÂÁÂ!

samwang

¦^´_ 8# zz0660


  ¤£·|¦]¬°¨ä¥LÀɦW¦Ó¶}±Ò¤£¤FÀɮסC
¥Ø«e­Ó¤H»{¬°¥i¯à¬OSplit¡A³oÃ䪺°ÝÃD§a?  

>> ·s¼W¦p¤U¬õ¦r¡A½Ð¦A´ú¸Õ¡AÁÂÁÂ
Sub test()
Dim Arr(), T$, d$, d1$, d2$, xY$, xM$, xD$
T = Date
Set fs = CreateObject("Scripting.FileSystemObject")
a = "D:\AA\BB\CC\DD"
Set f = fs.GetFolder(a)
Set fc = f.Files
For Each f1 In fc
    If UCase(Left(f1.Name, 3)) <> "L-M" Then GoTo 99
    d = Split(Split(f1.Name, ")")(1), "-")(0)
    xY = Left(d, 4): xM = Mid(d, 5, 2): xD = Right(d, 2)
    d1 = DateSerial(xY, xM, xD)
    d = Split(Split(Split(f1.Name, ")")(1), "-")(1), ".")(0)
    xY = Left(d, 4): xM = Mid(d, 5, 2): xD = Right(d, 2)
    d2 = DateSerial(xY, xM, xD)
    If T >= d1 And T <= d2 Then
        ReDim Preserve Arr(n)
        Arr(n) = f1.Path
        n = n + 1
    End If
99: Next

...
...

quickfixer

¦^´_ 8# zz0660

¸Õ¸Õ¬Ý,¥Îlike,¤£¥Îsplit~

    Sub test()

Dim fs As Object, f, fc, f1, d1, d2, d3
Set fs = CreateObject("Scripting.FileSystemObject")
a = "D:\AA\BB\CC\DD"
Set f = fs.GetFolder(a)
Set fc = f.Files
d3 = Format(Now(), "yyyymmdd")

For Each f1 In fc

    If f1.Name Like "L-M AA R S L(?*.xlsx" Then
         d1 = Mid(f1.Name, 22, 8)
        d2 = Mid(f1.Name, 31, 8)
      If d3 >= d1 And d3 <= d2 Then
             DoEvents
             Set WB = Workbooks.Open(f1)
        End If
    End If
Next

Set fs = Nothing

End Sub