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

[µo°Ý] ®Ú¾Ú"®Æ¸¹Äæ"¬°¨Ì¾Ú,°µ±Æ§Ç

[µo°Ý] ®Ú¾Ú"®Æ¸¹Äæ"¬°¨Ì¾Ú,°µ±Æ§Ç

¤j¤j­Ì¦n,

½Ð±Ð¦p¤U....
¨Ó·½Àɬ°°Ó«~2!·s¤ë¤u§@ªí       
§Ú¦³³\¦hªºÀɮ׳£»Ý­n®Ú¾Ú"®Æ¸¹Äæ"ªº®Æ¸¹¶¶§Ç¬°¨Ì¾Ú,°µ±Æ§Ç       
»Ý±Æ§Çªº¨C­ÓÀɪºªíÀY¦ì¸m,¤Î¤º®e³£¤£¤Ó¦P,       
¥ØªºÀɱƧǪº·Ç«h¬°¾ã¦C±Æ§Ç,­Y¦³¥¼¥X²{ªº®Æ¸¹,«h²¤¹L       
¨Ò:        ¼Ð¥Ü¶À©³,³£¬O¥ØªºÀÉ®w¦sªí¨S¦³ªº«~¶µ,«h¥ØªºÀɪº³o¨Ç®Æ¸¹,´N²¤¹L,¸õ¤U­Ó®Æ¸¹Ä~Äò±Æ§Ç
        ¥Ñ©ó¥ØªºÀɤ]·|¦³¨Ç¤u§@ªí»P®Æ¸¹µLÃö,¤£»Ý±Æ§Ç,
        ©Ò¥H»Ý±Æ§Çªº¤u§@ªí,¥H"·s¤ë"M1:M2©Ò«ü©wªº°_¨´¤u§@ªí§@¬°±Æ§Ç¹ï¶H
        ¨Ã¥B¦Û°Ê§ä´MªíÀY¦³"®Æ¸¹"¦r¼Ë,´N¨Ì"·s¤ë"ªº®Æ¸¹¶¶§Ç¾ã¦C±Æ§Ç

¨Ì·s¤ë¤u§@ªí_®Æ¸¹±Æ§Ç.rar (326.8 KB)

¥»©«³Ì«á¥Ñ PJChen ©ó 2021-4-6 23:16 ½s¿è

¤£¦n·N«ä,§Ú·Q§Úªí¹F±o¤£°÷²M·¡,¸É¥R¦p¤U¡G
¥ØªºÀɪº¸ô®|¦p¤U,¥¦¨S¦³«ü©w¯S©wÀÉ®×,³o­Ó¸ô®|©³¤Uªº©Ò¦³ÀÉ®×,³£¬O­n¥H·s¤ëªº®Æ¸¹Äæ±Æ§Çªº,
T:\0_¦Û­qªí³æ\¤é±`ªí®æ\
ÀÉ®×¥´¶}¥H«á,¥H"·s¤ë"M1:M2©Ò«ü©wªº°_¨´¤u§@ªí§@¬°±Æ§Ç¹ï¶H,
EX:
1) ²{¦b§Ú¥u©ñ¤@­Ó½d¨ÒÀÉ"®w¦sªí",¥H¤£«ü©wÀɦWªº¤è¦¡¶}±Ò
2) ¥H"·s¤ë"M1:M2©Ò«ü©wªº°_¨´¤u§@ªí,¬°2~6,
3) ±N®w¦sªí±q²Ä2~²Ä6ªº¤u§@ªíªº®Æ¸¹Äæ,¤ñ¹ï·s¤ëªº®Æ¸¹Ä檺¶¶§Ç¨Ó±Æ§Ç
4) ·s¤ëªº®Æ¸¹Äæ¬O±Æ§Çªº·Ç«h,¥¦ªº®Æ¸¹¤ñ¸û¦h,®w¦sªí¬O­n¨Ì·s¤ëªº®Æ¸¹Ä涶§Ç°µ±Æ§Ç,·í·s¤ëªº®Æ¸¹Äæ¬O¥ØªºÀɮƸ¹Äæ©Ò¨S¦³ªº®Æ¸¹,«h¸õ¤U­Ó®Æ¸¹Ä~Äò±Æ§Ç

¥Ñ©ó§Ú¦³³\¦hªºÀɮ׳£»Ý­n¦P¼Ëªº±Æ§Ç¤è¦¡,¦ý¦UºØÀɮ׮榡¤£¬Û¦P,¦ý»Ý­n±Æ§Çªº¤u§@ªí,³£«ü©w¦b"·s¤ë"M1:M2¬°°_¨´,¦ý¦]¬°®æ¦¡¤£¬Û¦P,¥´¶}Àɮ׫á,
°£¤F¨Ì¤u§@ªí°_¨´§@±Æ§Ç,»Ý­n¯à¦Û°Ê§ä¨ì"®Æ¸¹"¦r¼Ëªº¥\¯à,¤~¯à¨Ì¾Ú®Æ¸¹Äæ§@¾ã¦C±Æ§Ç

TOP

¥»©«³Ì«á¥Ñ °a¤ªºµ ©ó 2021-4-8 17:01 ½s¿è

¦^´_ 1# PJChen
¦³ªÅÀ°§Ú¸Õ¸Õ¬Ý¬O¤£¬O§A­nªºµ²ªG ·|«ÜºC¦]¬°°j°é¤Ó¦h¤F ¬Ý¬Ý¦³¨S¦³¤j¤jÄ@·NÀ°¦£ ·PÁÂ
  1. Public Sub ¸ó¤u§@ï¤ñ¹ï¨Ã²¾°Ê½m²ß()
  2.     Application.ScreenUpdating = False
  3.    
  4.     Sheets.Copy After:=Sheets(Sheets.Count)
  5.     For X = [H65535].End(3).Row To 1 Step -1
  6.         If IsError(Cells(X, "H")) Then
  7.             Rows(X).Delete
  8.         End If
  9.     Next X
  10.     Range([A65535].End(3), [A4]).Sort [A4], 1, Header:=2
  11.    
  12.    
  13.     Set xD = CreateObject("Scripting.Dictionary")
  14.     Arr = Range([A65535].End(3), [A1])
  15.    
  16.     Application.DisplayAlerts = False
  17.     Sheets(Sheets.Count).Delete
  18.     Application.DisplayAlerts = True
  19.    
  20.     For X = 1 To UBound(Arr, 1)
  21.             xD(Arr(X, 1)) = Trim(xD(Arr(X, 1)) & " " & X)
  22.     Next X
  23.     Erase Arr
  24.    
  25.     A = Dir("T:\0_¦Û­qªí³æ\¤é±`ªí®æ\*.xlsx")
  26.     Workbooks.Open "T:\0_¦Û­qªí³æ\¤é±`ªí®æ\" & A & ""
  27.     Set W = Workbooks("°Ó«~2.xlsm").Sheets(1)
  28.    
  29.     For E = 1 To Sheets.Count
  30.         N = Sheets(E).Name: Sheets(E).Activate
  31.         If IsNumeric(N) Then
  32.             If Int(N) > W.[M2] Then Exit For
  33.             If Int(N) >= W.[M1] And Int(N) <= W.[M2] Then
  34.                 Arr = ActiveSheet.UsedRange
  35.                 For X = 1 To UBound(Arr, 1)
  36.                     For Y = 1 To UBound(Arr, 2)
  37.                         If Arr(X, Y) = "®Æ¸¹" Then
  38.                             Brr = Range(Cells(1, Y), Cells(Rows.Count, Y).End(3))
  39.                             GoTo A01
  40.                         End If
  41.                     Next Y
  42.                 Next X
  43. A01:            Y = Y: Erase Arr
  44.                
  45.                 For Each D In xD
  46.                 SR = Split(xD(D), " ")
  47.                     For Each S In SR
  48.                         SInt = Int(S)
  49.                         For Z = UBound(Brr) To 1 Step -1
  50.                         On Error Resume Next
  51.                             If D <> Empty Then
  52.                                 If D = Brr(Z, 1) Then
  53.                                     Rows(Z).Cut
  54.                                     Rows(SInt).Insert , 1
  55.                                     Brr = Range(Cells(1, Y), Cells(Rows.Count, Y).End(3))
  56.                                     Exit For
  57.                                 End If
  58.                             End If
  59.                         On Error GoTo 0
  60.                         Next Z
  61.                     Next S
  62.                 Next D
  63.         
  64.             End If
  65.         End If
  66.     Next E
  67.    
  68.     Application.ScreenUpdating = True
  69. End Sub
½Æ»s¥N½X
°Ó«~20408.rar (38.23 KB)

TOP

¥»©«³Ì«á¥Ñ PJChen ©ó 2021-4-8 23:43 ½s¿è

¦^´_ 3# °a¤ªºµ
±z¦n,
¨Ó·½ÀÉ«ü©w°_¨´¤u§@ªí,³o­Ó¼gªk,·|¨Ï¥¦¥h´M§ä¼Æ¦r¤u§@ªí,°_¨´¤u§@ªí,§Æ±æ¯à¼Æ²Äx~²Äx­Ó¤u§@ªí,
¦]¬°¦³¨Ç¤u§@ªí¬O«D¼Æ¦rªº,½Ð°Ý­n«ç»ò§ï?
    For E = 1 To Sheets.Count
        N = Sheets(E).Name: Sheets(E).Activate
        If IsNumeric(N) Then
            If Int(N) > W.[M2] Then Exit For
            If Int(N) >= W.[M1] And Int(N) <= W.[M2] Then

¥t¥~½Ð°Ý,³o¬q¦p¦ó¸ÑŪ? ¬O§_¬°¨Ó·½ÀɪºHÄæ? ¨Ó·½ÀÉ°£¤FAÄæ®Æ¸¹¬O¥Î¨Ó§@¬°±Æ§Ç·Ç«h,¤ÎM1¡BM2¥Î¨Ó¼Æ¤u§@ªí°_¨´¥~,¨ä¾lÄæ¦ì³£¤£¯à¥Îªº¡I
    For X = [H65535].End(3).Row To 1 Step -1
        If IsError(Cells(X, "H")) Then
            Rows(X).Delete
        End If
    Next X
    Range([A65535].End(3), [A4]).Sort [A4], 1, Header:=2

TOP

¦^´_ 4# PJChen

    For E = 1 To Sheets.Count
        N = Sheets(E).Name: Sheets(E).Activate
        If IsNumeric(N) Then
            If Int(N) > W.[M2] Then Exit For
            If Int(N) >= W.[M1] And Int(N) <= W.[M2] Then
¥i¥H§ï¦¨
    For E = 1 To Sheets.Count
        Sheets(E).Activate
        If E > W.[M2] Then Exit For
        If E >= W.[M1] And E <= W.[M2] Then

³o¬q
    For X = [H65535].End(3).Row To 1 Step -1
        If IsError(Cells(X, "H")) Then
            Rows(X).Delete
        End If
    Next X
    Range([A65535].End(3), [A4]).Sort [A4], 1, Header:=2

¬O¥Î HÄæ °µ±Æ§Ç«áªº¨Ì¾Ú ¦]¬°¥i¥H±Æ°£¨S¦³ªº¸ê®Æ
©ÎµÛ §A¥i¥H§ï¦¨

    Sheets.Copy After:=Sheets(Sheets.Count)
    For X = [H65535].End(3).Row To 1 Step -1
        If IsError(Cells(X, "A")) Then
            Rows(X).Delete
        End If
    Next X
    Range([A65535].End(3), [A4]).Sort [A4], 1, Header:=2
¨ä¹ê¤]¨S®t ¦]¬° If D = Brr(Z, 1) Then ¤w¸g¥i¥H¸õ¹L¤F

§Ú¦³µy·L­×§ï¤F¤@¤U³o¬q

            For Each D In xD
                SR = Split(xD(D), " ")
                For Each S In SR
                    SInt = Int(S)
                    If D = Empty Then Exit For
                    With Range(Cells(1, Y), Cells(Rows.Count, Y).End(3))
                        On Error Resume Next
                        Set C = .Find(D)
                        G = .FindNext(C).Address
                        If C = D Then
                            If Not C Is Nothing Then
                                Rows(C.Row).Cut
                                Set C = .FindNext(G)
                                Rows(SInt).Insert , 1
                            End If
                        End If
                        On Error GoTo 0
                    End With
                Next S
            Next D


¦ýÁÙ¬O«ÜºC ..¦pªG¸ê®Æ¶q¤j·|«D±`ºC... .¬Ý¬Ý¦³¨S¦³¤j¤j¥i¥HÀ°¦£

TOP

¦^´_ 5# °a¤ªºµ
¤£¦n·N«ä
§Ú­ì¨Ó·Q±o«Ü¦h,µ²ªGµ{¦¡´NÅܱo«Ü½ÆÂø,§Ú·Q§ï¬°³æ¯Â¤Æ,¥u­n
1) ¨Ì¨Ó·½ÀÉ"°Ó«~2"ªºAÄæ§@¬°±Æ§Ç¨Ì¾Ú
2) ¥H®w¦sÀɪº"¾ã¤ë²Î­p"(·N«ä¬O«ü©w³æ¤@¤u§@ªí´N¦n)",·j´M®Æ¸¹Äæ¨Ó¾ã¦C±Æ§Ç
3) ®w¦sÀɪº®Æ¸¹»P¨Ó·½Àɹ藍¤W®É,¤@«ß±Æ¦b¤U¤è
4) ­Y®Æ¸¹¬Û¦P,«h¥H¨Ó·½ªº®Æ¸¹¶¶§Ç¨Ó±Æ§Ç
5) ¯à§_¦bµ{¦¡¤¤µù¸Ñ,§Ú·Q¤F¸Ñµ{¦¡§@¥Î

²{¦b¥i¥H±Æ§Ç,¦ýµ²ªG¬O¿ù»~ªº,¦Ó¥B·|±N"¾ã¤ë²Î­p"¤¤ªí®æªº³Ì«á¤@¦C½ð¨ì²Ä77¦C,¯à§_À°¦£¬Ý¬Ý¡H
§Ú§â±Æ§Ç«áªº¥¿½Tµ²ªG©ñ¦b"¾ã¤ë²Î­p"

¨Ì·s¤ë¤u§@ªí_®Æ¸¹±Æ§Ç.rar (287.38 KB)

TOP

¦^´_ 6# PJChen

¦³ªÅ¦AÀ°§Ú¸Õ¸Õ¬Ý¬O¤£¬O§A­nªºµ²ªGÁÂÁÂ
  1. Public Sub ¸ó¤u§@ï¤ñ¹ï¨Ã²¾°Ê½m²ß0409()
  2.     Application.ScreenUpdating = False
  3.     '·s¼W¤@­Ó¤u§@ªí±Æ¦C«á ¦s¨ì°}¦C¦b§R°£¤u§@ªí
  4.     Sheets.Copy After:=Sheets(Sheets.Count)
  5.     Range([A65535].End(3), [A4]).Sort [A4], 1, Header:=2

  6.     Set xD = CreateObject("Scripting.Dictionary")
  7.     Arr = Range([A65535].End(3), [A1])
  8.    
  9.     Application.DisplayAlerts = False
  10.     Sheets(Sheets.Count).Delete
  11.     Application.DisplayAlerts = True
  12. '--------------------------------------------------------
  13.     '§â±Æ¦C«áªº¸ê®Æ¦s¨ì¦r¨å¸Ì
  14.     For X = 1 To UBound(Arr, 1)
  15.         xD(Arr(X, 1)) = Trim(xD(Arr(X, 1)) & " " & X)
  16.     Next X
  17.     Erase Arr
  18. '--------------------------------------------------------
  19.     '´M§äÀɮתº¦ì¸mµM«á¶}±Ò
  20.     A = Dir(ThisWorkbook.Path & "\" & "*.xlsx")
  21.     Workbooks.Open ThisWorkbook.Path & "\" & A
  22. '--------------------------------------------------------
  23.     '¤Á´«¨ì«ü©w¤u§@ªí §â§t¦³"®Æ¸¹"ªº¨º¤@Äæ¦ì¸m°O¤U¨Ó
  24.     Sheets("¾ã¤ë²Î­p").Activate '³o¸Ì¥i¥H«ü©w­n±Æ¦Cªº¤u§@ªíªº¦ì¸m "¾ã¤ë²Î­p" ©Î "3"
  25.     Arr = ActiveSheet.UsedRange
  26.     For X = 1 To UBound(Arr, 1)
  27.         For Y = 1 To UBound(Arr, 2)
  28.             If Arr(X, Y) = "®Æ¸¹" Then
  29.                 Y = Y
  30.                 X = X + 1
  31.                 GoTo A01
  32.             End If
  33.         Next Y
  34.     Next X
  35. A01: Erase Arr
  36. '--------------------------------------------------------
  37.     '´M§ä¤ñ¹ï«á¨Ã­«·s±Æ¦C
  38.     For Each D In xD
  39.         SR = Split(xD(D), " ")
  40.         For Each S In SR
  41.             If D = Empty Then Exit For
  42.             With Range(Cells(1, Y), Cells(Rows.Count, Y).End(3))
  43.                 On Error Resume Next
  44.                 Set C = .Find(D)
  45.                 G = .FindNext(C).Address
  46.                 If C = D Then
  47.                     If Not C Is Nothing Then
  48.                         Rows(C.Row).Cut
  49.                         Set C = .FindNext(G)
  50.                         K = K + 1
  51.                         Rows(X + K).Insert , 1
  52.                     End If
  53.                 End If
  54.                 Application.CutCopyMode = False
  55.                 On Error GoTo 0
  56.             End With
  57.         Next S
  58.     Next D
  59.     Set C = Nothing
  60.    
  61.     Application.ScreenUpdating = True
  62. End Sub
½Æ»s¥N½X
0409.rar (287.7 KB)

TOP

¦^´_ 7# °a¤ªºµ

ºµ¤j¦n,
¤ÏÂдú¸Õ,¥¦ÁÙ¬OµLªk¥¿½T±Æ§Ç,§Ú§â¥¿½T¤Î¿ù»~ªº±Æ¦C³£¯d¦bÀɮפ¤,
½Ð¦AÀ°¦£¬Ý¤U....
R0409.rar (423.95 KB)

TOP

¦^´_ 8# PJChen


§Ú¥H¬°§A­n­«·s±Æ¦C ©Ò¥H¤~·|¥[¤J³o¬q
    '·s¼W¤@­Ó¤u§@ªí±Æ¦C«á ¦s¨ì°}¦C¦b§R°£¤u§@ªí
§â³o¨Ç§R°£¦A¸Õ¸Õ¬Ý ¬O¤£¬O§A­nªºµ²ªG ·PÁÂ
'    Sheets.Copy After:=Sheets(Sheets.Count)
'    Range([A65535].End(3), [A4]).Sort [A4], 1, Header:=2

    Set xD = CreateObject("Scripting.Dictionary")
    Arr = Range([A65535].End(3), [A1])
   
'    Application.DisplayAlerts = False
'    Sheets(Sheets.Count).Delete
'    Application.DisplayAlerts = True

«O¯d
    Set xD = CreateObject("Scripting.Dictionary")
    Arr = Range([A65535].End(3), [A1])

TOP

¦^´_ 9# °a¤ªºµ
¤£¦n·N«ä,±Æ§ÇÁÙ¬O·|¥X¿ù,
"¾ã¤ë²Î­p"ªºªíÀY­ì¨Ó¦b²Ä3¦C,¬°¤F´ú¸Õ¥Î§Ú§â¤W¤èÀH·N¼W´îªÅ¥Õ¦C,²{¦bªíÀY©ñ¦b²Ä6¦C,
µ²ªG¤£¦ý±Æ¦C¿ù»~,¦Ó¥B·|±N­ì¨ÓªºªíÀY²Ä2¦C,²¾°Ê¨ì¤U¤è....
¦b°»´ú"®Æ¸¹"ªº©Ò¦b¦ì¸m®É,±q®Æ¸¹©¹¤Wªº©Ò¦³¦C¼Æ,³£ÄÝ©óªíÀY¦ì¸m,¤£¯à¦C¤J±Æ§Ç½d³ò,
¤£µMªí®æ·|¤j¶Ã....¦A³Â·Ð±z¤F.
RR0409.rar (300.39 KB)

TOP

        ÀR«ä¦Û¦b : ­n§åµû§O¤H®É¡A¥ý·Q·Q¦Û¤v¬O§_§¹¬üµL¯Ê¡C
ªð¦^¦Cªí ¤W¤@¥DÃD