jcchiang

¦^´_ 1# PJChen

¸Õ¸Õ¬Ý
Sub ex()
Dim fds As Object, fs$, Path$
Dim c As Variant, a As Variant
Application.ScreenUpdating = False
Set c = Nothing
Path = ThisWorkbook.Path
For Each a In Sheets("CVS").Range([a3], [a3].End(4))
   If Sheets("VBA").[AS7] = "V" And Sheets("VBA").[AS6] <> "" Then '[AS7] & [AS6]¬Ò¤£¬°ªÅ¥Õ
      If a = "µ²§ô" Or a.Offset(, 8) = "" Or a.Offset(, 8) < Sheets("VBA").[AS6] Then '¤ñ¹ïAÄæ¬O§_¬°"µ²§ô",IÄæ¬O§_¬°ªÅ¥Õ©Î¤p©ó[AS6]
         If c Is Nothing Then
           Set c = a.Resize(, 14)
         Else
           Set c = Union(c, a.Resize(, 14))
         End If
      End If
   ElseIf Sheets("VBA").[AS7] = "V" And Sheets("VBA").[AS6] = "" Then '[AS7]¤£¬°ªÅ¥Õ,[AS6]¬°ªÅ¥Õ
      If a = "µ²§ô" Then                                              '¤ñ¹ïAÄæ¬O§_¬°"µ²§ô"
         If c Is Nothing Then
           Set c = a.Resize(, 14)
         Else
           Set c = Union(c, a.Resize(, 14))
         End If
      End If
   ElseIf Sheets("VBA").[AS7] = "" And Sheets("VBA").[AS6] <> "" Then '[AS7]¬°ªÅ¥Õ,[AS6]¤£¬°ªÅ¥Õ
      If a.Offset(, 8) = "" Or a.Offset(, 8) < Sheets("VBA").[AS6] Then '¤ñ¹ïIÄæ¬O§_¬°ªÅ¥Õ©Î¤p©ó[AS6]
         If c Is Nothing Then
           Set c = a.Resize(, 14)
         Else
           Set c = Union(c, a.Resize(, 14))
         End If
      End If
   End If
Next
c.EntireRow.Delete  '±N²Å¦X±ø¥óªº¦C§R°£
Application.DisplayAlerts = False
Set fds = CreateObject("Scripting.filesystemobject")
fs = Dir(Path & "\AAA-" & Format(Date, "yyyymmdd") & "*.xlsx")  '¨Ó·½Àɮ׸ê®Æ§¨¤ºªºÀɮצW
Do Until fs = "" 'ª½¨ìŪ¨úÀɮצW¬OªÅ¦r¦ê
   If fds.FileExists(Path & fs) Then Kill Path & fs '¦pªGÀɮפw¸g¦s¦b´N¥ý§R°£ÀÉ®×
   fs = Dir '¤U¤@­ÓÀÉ®×
Loop
ActiveWorkbook.SaveAs Filename:=Path & "\AAA-" & Format(Date, "yyyymmdd") + ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Workbooks("«P¾P¸ê°T.xlsm").Close False
End Sub