[µo°Ý] ¨Ì±ø¥ó§R°£¾ã¦C¸ê®Æ

PJChen

¦­¦w¡G

½Ð°Ý¥H¤U¸Ó¦p¦ó¼gµ{¦¡??
a) °õ¦æµ{¦¡®É,¤£­nÅÜ°ÊCVS¤u§@ªíA:Sªº¤½¦¡¤Î®æ¦¡
b) CVS¤u§@ªíAÄæ & IÄæ²Å¦X±ø¥ó«h¾ã¦C§R°£,¨Ã¥t¦s·sÀÉ....AAA_YYYYmmdd

c) AÄæ:¥HVBA¤u§@ªí[AS7]¬°±ø¥ó,·í[AS7]="",«hAÄ椣¤ñ¹ï,·í[AS7]="V",«h²Å¦X±ø¥ó,±NAÄæ="µ²§ô",¾ã¦C§R°£

d) IÄæ±ø¥ó:¥HVBA¤u§@ªí[AS6]¬°±ø¥ó,·í[AS6]="",«hIÄ椣¤ñ¹ï,·íIÄ檺¤é´Á="" or IÄæ¤é´Á<[AS6],¾ã¦C§R°£

«P¾P¸ê°T.rar (47.56 KB)

¤U¸ü¦¸¼Æ: 7

2021-3-2 05:19

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

PJChen

¦^´_ 2# jcchiang

·PÁ¤j¤jªºÀ°¦£,
µ{¦¡OK

­ã´£³¡ªL

¥u°µ§R°£³¡¥÷
Sub TEST()
Dim Arr, KS$, DS, D, R&, xR As Range, xU As Range, N&
If [VBA!AS7] = "V" Then KS = "µ²§ô" Else KS = "|^|"
If IsDate([VBA!AS6]) Then DS = CDate([VBA!AS6]) Else DS = -9
R = [CVS!A65536].End(xlUp).Row - 2
If R <= 0 Then Exit Sub
For Each xR In [CVS!A3].Resize(R)
    If IsDate(xR(1, 9)) Then D = CDate(xR(1, 9)) Else D = 0
    If xR = KS Or xR(1, 9) < DS Then
       N = N + 1
       If N = 1 Then Set xU = xR Else Set xU = Union(xU, xR)
    End If
Next
If N > 0 Then xU.EntireRow.Delete
MsgBox "¦@¦³ " & N & " µ§³Q§R°£ "
End Sub


'=========================

PJChen

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

­ã¤j¦n,
­ìµ{¦¡°õ¦æ¨S°ÝÃD,µy¥[­×§ï¬°¥i¥H¦Û¦æ¶}±Ò,¨Ã±N¤u§@ªí«ü©w¬°Sh,¦ýµLªk°õ¦æ,§iª¾»Ý­nª«¥ó?
Set Sh = xB.Sheets("CVS")
R = [Sh!A65536].End(xlUp).Row - 2

¥t¸ê®Æ¤j´T§R°£«á,§Ú·QÅý¸ê®Æµe­±°±¦b¤u§@ªí¦³¸ê®Æªº³Ì«á¤@¦C,¦ýµL§@¥Î,½Ð°Ý­n«ç»ò§ï¼g?
xrow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A2:A" & xrow).Activate

¾ã¦C§R°£_«P¾P¸ê°T.rar (44.95 KB)

¤U¸ü¦¸¼Æ: 3

2021-3-4 23:53

­ã´£³¡ªL

¦^´_ 5# PJChen

R = Sh.[A65536].End(xlUp).Row - 2

For Each xR In Sh.[A3].Resize(R)

Sh.Cells(Rows.Count, 1).End(xlUp).Select '³Ì«á¤@¦æ

­ã´£³¡ªL

¦^´_ 5# PJChen


Do While FN <> ""
Set xB = Nothing
On Error Resume Next: Set xB = Workbooks(FN): On Error GoTo 0 '³o¥Î¨ÓÀˬdÀɮ׬O§_¤w¶}±Ò
If xB Is Nothing Then Set xB = Workbooks.Open(PH & FN) 'ÀÉ®×¥¼¶}±Ò®É¤~¯à¥Îopen, §_«h­«Âж}±Ò·|³y¦¨·í¾÷
Set Sh = xB.Sheets("CVS")

ª`·N¬õ¦â³¡¥÷