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

[µo°Ý] ¨Ì±ø¥ó½Æ»s¤£¦P¤u§@ªí¸ê®Æ¨Ã²Î­p¤£­«½Æ¦¸¼Æ

¦^´_ 10# ­ã´£³¡ªL
Dear «e½ú¡I«D±`·PÁÂ
¦p©ó°õ¦æ«e§PÂ_NL©ÎSL¤u§@ªí¬O§_¦s¦b¡H¤£¦s¦b«hµ²§ô°õ¦æ¡A¦p¤U¦p¦ó§ó§ï¡CÁÂÁ¡I
Dim ws As Worksheet
Dim sName As String
sName = "NL"
On Error Resume Next
Set ws = Sheets(sName)
If ws Is Nothing Then
    MsgBox "NL or SL¤u§@ªí¤£¦s¦bµ²§ô°õ¦æ"
    Exit Sub
End If
100 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

¦^´_ 11# b9208

For Each S In Array("NL", "SL")
    On Error Resume Next
    If Sheets(S & "") Is Nothing Then
       MsgBox "¤u§@ªí:¡e" & S & "¡f¤£¦s¦b! ": Exit Sub
    End If
    On Error GoTo 0
Next

TOP

¦^´_ 12# ­ã´£³¡ªL
Dear ­ã¤j
«D±`·PÁÂ
¦p±N©Ò¦³¸ê®Æ²¾°Ê½Æ»s¨ì¥DÀÉ¡A¥DÀÉÀÉ®×·|Åܫܤj¡]¬ù30¦hMB¡^¡C
½Ð°Ý¥i¥H¤£¥Î±N¸ê®Æ²¾¨ì¥DÀÉ¡A´N¥i¥H¨Ì¿z¿ï±ø¥ó½Æ»s¸ê®Æ¨ì¥DÀɶܡH
¥DÀɦWºÙ¡GTOTAL
¸ê®ÆÀɦWºÙ¡GData1, 2, 3¡K¡K.¡]¤u§@ªí¦WºÙ¡GLIST¡^
¥H¤WÀɮצP¤@¸ê®Æ§¨
ÁÂÁÂ
T18.rar (44.26 KB)
100 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

¦^´_ 13# b9208


ªþÀÉ:
T18-01.rar (56.23 KB)

TOP

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

­ã¤j±z¦n
½Ð±Ð·Q­n©ó¡uTOTAL Á`ªí¡vB2Àx¦s®æ­È½Æ»s¨ä¥LEXCELÀɤºA2ªº­È¡]¨ä¥LÀɮפºA2­È³£¬O¬Û¦Pªº¡^¡A¦p¦ó­×­q¥¨¶°¡H
Àµ½Ð«ü¾É
ÁÂÁ¡I
20210206.rar (59.08 KB)
100 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

¦^´_ 15# b9208


  Set xB = Workbooks.Open(PH & "\" & FN, ReadOnly:=True)
   Set xS = xB.Sheets(1)
   If DateStr = "" Then DateStr = xS.[A2]
   Arr = Range(xS.[A1:O1], xS.UsedRange)


If M > 0 Then
   [Á`ªí!b2] = DateStr

end if

´¡¤J¬õ¦â¦r¨º¤G¦æ~~

TOP

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

­ã¤j
«D±`·PÁÂ
100 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2022-12-5 16:45 ½s¿è

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


    ÁÂÁ ­ã´£³¡ªL«e½ú«ü¾É
ÁÂÁ b9208«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«²ß±o«Ü¦hª¾ÃÑ,ÁÂÁ½׾Â
°õ¦æ²Ó¸`»P¤ß±oµù¸Ñ¦p¤U,½Ð«e½ú¦A«ü¾É!ÁÂÁÂ

°õ¦æ«e:
2022-12-05_161531.JPG
2022-12-5 16:26


°õ¦æ«á:
2022-12-05_162007.JPG
2022-12-5 16:26


Option Explicit
Sub TEST_Á`ªí()
Dim Arr, Brr, xD, PH$, FN$, i&, j&
'¡ô«Å§i(Arr, Brr, xD)¬O³q¥Î«¬ÅܼÆ,(PH$, FN$)¬O¦r¦êÅܼÆ,(i,j)¬Oªø¾ã¼ÆÅܼÆ
Dim xB As Workbook, xS As Worksheet, TT$, T$(4), M&, U&
'¡ô«Å§i(xB)¬O¬¡­¶Ã¯ÅܼÆ,(xS)¬O¤u§@ªíÅܼÆ,
'(TT)¬O¦r¦êÅܼÆ,T¬O5­Ó¤¸¯Àªº¤@ºû¦r¦ê°}¦CÅܼÆ,(M&,U&)¬Oªø¾ã¼ÆÅܼÆ

Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxD ¬O¦r¨å
PH = ThisWorkbook.Path
'¡ô¥OPH¦r¦êÅܼƬO ²{¦b³o¬¡­¶Ã¯ªº©Ò¦bÀɮצì¸m
Call ²M°£_Á`ªí
'¡ô°õ¦æ °Æµ{¦¡ ²M°£_Á`ªí()
'--------------------------

Arr = Range([Á`ªí!a1], [Á`ªí!a65536].End(xlUp))
'¡ô¥OArr¬O°}¦C!­Ë¤J"Á`ªí"¤u§@ªí[A1]¨ì"Á`ªí"¤u§@ªíAÄæ³Ì«á¤@­Ó¦³¤º®eªºÀx¦s®æ
For i = 2 To UBound(Arr)
'¡ô³]¶¶°j°éi±q2 ¨ìArr°}¦CÁa¦V³Ì¤j¦C¸¹
    If Arr(i, 1) <> "" Then xD(Arr(i, 1) & "//a") = 1
    '¡ô¦pªGArr°}¦C°j°é¦C²Ä¤@Ä檺­È¤£¬O ªÅ¦r¤¸!
    '´N¥HArr°}¦C°j°é¦C²Ä¤@Ä檺­È ³s±µ "//a" ¦r¦ê ·íxD¦r¨åªºKEY,
    'item¬O¼Æ¦r1

Next i
ReDim Brr(1 To 2000, 1 To 15)
'¡ô«Å§iBrr°}¦Cªº½d³ò!Áa¦V±q1¨ì2000¦C,¾î¦V±q1¨ì15Äæ
'--------------------------

Application.ScreenUpdating = False
'¡ô¿Ã¹õµe­±¤£¸òµÛ°õ¦æµ{§ÇÅܤÆ
Do
'¡ô³]µL­­°j°é!¶}©l°õ¦æ«á­±ªºµ{§Ç,¦Û¤v·Q¿ìªk¸õ¥X°j°é
   If FN = "" Then
   '¡ô¦pªGFN¦r¦êÅܼƬO ªÅ¦r¤¸??
      FN = Dir(PH & "\*.xls")
      '¡ô¥OFN¦r¦êÅܼƬO ²{¦b³o¬¡­¶Ã¯ªº©Ò¦bÀɮצì¸mªºEXCELÀÉ®×
      Else
         FN = Dir
         '¡ôFN³v¦¸§ì¨ú¬Û¦P¸ô®|¤Uªº·í¦W
         'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/dir-function
   End If
   If FN = "" Then Exit Do
   '¡ô¦pªGFN¦r¦êÅܼƬOªÅ¦r¤¸!¥Nªí¬Û¦P¸ô®|¤UªºÀɦW¤w¸g³£§ì¹L¤F,´N¸õ¥XDo~Loopªº°j°é
   If FN = ThisWorkbook.Name Then GoTo DP
   '¡ô¦pªGFN¦r¦êÅܼƬO ²{¦b³o¬¡­¶Ã¯ªº¦WºÙ¦r¦ê!´N¸õ¨ì DP ¦ì¸mÄ~Äò°õ¦æ
   '--------------------------

   Set xB = Workbooks.Open(PH & "\" & FN, ReadOnly:=True)
   '¡ô¥OxB ¬O¥H°ßŪ¤è¦¡¥´¶} PH¦r¦êÅÜ¼Æ & "\" & FN¦r¦êÅܼƲզX¦¨¦r¦êªº¬¡­¶Ã¯
   Set xS = xB.Sheets(1)
   '¡ô¥OxS ¬O¥´¶}ªº³o¬¡­¶Ã¯ªº²Ä¤@­Ó¤u§@ªí
   Arr = Range(xS.[A1:O1], xS.UsedRange)
   '¡ô¥OArr­Ë±¼­ì¨Óªº°}¦C­È!Åܦ¨·s°}¦C,­Ë¤J¥´¶}ªº¬¡­¶Ã¯²Ä¤@­Óªí¥þ³¡¦³¨Ï¥ÎªºÀx¦s®æ­È
   For i = 6 To UBound(Arr)
   '¡ô³]¥~¶¶°j°é!i±q6¨ìArr°}¦CÁa¦V³Ì¤j¦C¸¹
       T(1) = Arr(i, 6)
       '¡ô¥OT¤@ºû°}¦Cªº²Ä¤G­Ó¦r¦ê¬Oi°j°é¼Æ²Ä¤»ÄæArr°}¦C­È
       T(2) = Arr(i, 8)
       '¡ô¥OT¤@ºû°}¦Cªº²Ä¤T­Ó¦r¦ê¬Oi°j°é¼Æ²Ä¤KÄæArr°}¦C­È
       T(3) = Left(Arr(i, 9), 7)
       '¡ô¥OT¤@ºû°}¦Cªº²Ä¥|­Ó¦r¦ê¬Oi°j°é¼Æ²Ä¤EÄæArr°}¦C­Èªº¥ªÃä7­Ó¦r¤¸
       T(4) = Arr(i, 3)
       '¡ô¥OT¤@ºû°}¦Cªº²Ä¤­­Ó¦r¦ê¬Oi°j°é¼Æ²Ä¤TÄæArr°}¦C­È
       If T(1) = "" Or xD(T(1) & "//a") = 0 Then
       '¡ô¦pªGT°}¦Cªº²Ä¤G­Ó¦r¦ê¬O ªÅ¦r¤¸ ©Î
       '¥H T°}¦Cªº²Ä¤G­Ó¦r¦ê³s±µ "//a"¦r¦ê¬d¹îxD¦r¨å ¬O0??

          GoTo 101
          '¡ô±ø¥ó¦¨¥ß!´N¸õ¨ì 101ªº¦ì¸mÄ~Äò°õ¦æ
       End If
       TT = T(1) & "|" & T(2) & "|" & T(3) & "|" & T(4)
       '¡ô¥OTT¦r¦êÅܼƬOT°}¦C¸Ì²Ä¤G­Ó¦r¦ê¨ì²Ä¤­­Ó¦r¦ê¤¤¶¡³s±µ"|"²Å¸¹ªº¦r¦ê
       U = xD(TT)
       '¡ô¥OU ¬O¥HTT¦r¦ê¬°key¬d¹îxD¦r¨å±o¨ìªºItem­È,Âର¾ã¼Æ¼Æ¦r
       If U = 0 Then
       '¡ô¦pªGU ¬O0,³o§PÂ_¦¡¬O­n±Æ°£­«½Æ!²Ä¤@¦¸¥X²{ªºTT¦r¦ê¤~·|±ø¥ó¦¨¥ß
          M = M + 1
          '¡ô¥OM²Ö¥[1
          U = M
          '¡ô¥OU ¸ËMªº­È(¾ã¼Æ¼Æ¦r)
          xD(TT) = U
          '¡ô¥HTT¦r¦ê·íkey,Item¬O U¼Æ¦rÅܼÆ
       End If
       If Arr(i, 11) > Brr(U, 11) Or Brr(U, 11) = Empty Then
       '¡ô¦pªG°j°é¦C¼Æ²Ä11Ä檺Arr°}¦C­È ¤j©óU¦C²Ä11Ä檺Brr°}¦C­È,
       '©ÎU¦C²Ä11Ä檺Brr°}¦C­È¬Oªì©l­È(¨SÅܹL)

          For j = 1 To UBound(Brr, 2)
          '¡ô³]¤º¶¶°j°é!j±q1 ¨ìBrr°}¦C¾î¦V³Ì¤jÄ渹
             Brr(U, j) = Arr(i, j)
             '¡ôU¦C¸¹ j¤º°j°éÄ渹ªºBrr°}¦C­È = ¥~°j°éi¦C¸¹ j¤º°j°éÄ渹ªºArr°}¦C­È
          Next
          Brr(U, 9) = Left(Brr(U, 9), 7)
          '¡ôU¦C¸¹ ²Ä9Ä渹ªºBrr°}¦C­È = ¦Û¤vªº­È¨ú¥ª°¼ªº7 ­Ó¦r¤¸
       End If
101: Next i
   xB.Close 0
   '¡ôÃö³¬³Q¶}±Òªº xB¬¡­¶Ã¯ÅܼÆÀÉ®×(¤£¦sÀÉ)
DP: Loop
'¡ôµL­­°j°éªºÂà§éÂI!¸õ¨ì«e­±ªºDo¦ì¸mÄ~Äò°õ¦æ!
'--------------------------
If M > 0 Then
'¡ô¦pªGM¾ã¼ÆÅܼƤj©ó0 (³o¸ÌªºM «üªº¬O ­ì¥»Brr(1 To 2000, 1 To 15)ªÅ°}¦C³Q¨Ï¥Îªº¦C¼Æ)
   With [Á`ªí!b6].Resize(M, UBound(Brr, 2))
   '¡ô¥H¤UÃö©ó "Á`ªí"¤u§@ªí[B6]¦V¤UÂX®iM¦C,¦V¥kÂX®iBrr°}¦C¾î¦V³Ì¤jÄ渹¼ÆÄæ ªºÀx¦s®æ°Ï°ì
         .Value = Brr
         '¡ô³oÂX®i°Ï°ìÀx¦s®æ¥HBrr°}¦C­È­Ë¤J
         .Borders.LineStyle = 1
         '¡ô¥O³oÂX®i°Ï°ìÀx¦s®æªº®æ½u¼Ë¦¡¬O ²Ó¹ê½u
         .Sort key1:=.Item(3), Order1:=xlAscending, _
               key2:=.Item(8), Order2:=xlAscending, Header:=xlNo
         '¡ô³oÂX®i°Ï°ìÀx¦s®æ°µ¨â¼h¦¸ªº¾ã¦C±Æ§Ç,²Ó¸`¦p¤U:
         '1.±N³oÂX®i°Ï°ìÀx¦s®æªº¬Û¹ï²Ä¤TÄæ¦ì(ªí¸Ìªº DÄæ),°µ¤p¨ì¤jªº±Æ§Ç
         '2.¨Ã±N¤@¦¸±Æ§Ç«á¸Ì­±¬Û¦P­È,¦A¹ï¬Û¹ï²Ä¤KÄæ¦ì(ªí¸Ìªº IÄæ),°µ¤p¨ì¤jªº±Æ§Ç

   End With
End If
Set Arr = Nothing
Set Brr = Nothing
Set xD = Nothing
End Sub
Sub ²M°£_Á`ªí()
Sheets("Á`ªí").UsedRange.Offset(5, 0).Offset(, 1).Delete Shift:=xlUp
'¡ô"Á`ªí"¤u§@ªí¦³¨Ï¥ÎªºÀx¦s®æ½d³ò,©¹¤U°¾²¾5¦C,¥ª¥k¤£°¾²¾,¤§«á¦A©¹¥k°¾²¾1Äæ,
'¦¹Àx¦s®æ½d³ò§R°£!¨Ã¥Ñ¤U¤èªºÀx¦s®æ©¹¤W»¼¸É


'Offset(5, 0).Offset(, 1) = Offset(5, 0).Offset(0 , 1)
'Offset(5, 0).Offset(, 1) = Offset(5).Offset( , 1)
'Offset(5, 0).Offset(, 1) = Offset(5, 1)
'Offset(5,  ).Offset(, 1) ·|¥X²{ ½sĶ¿ù»~

'https://learn.microsoft.com/zh-tw/office/vba/api/excel.range.offset
End Sub

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2022-12-6 09:05 ½s¿è

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


        ¦A¦¸ÁÂÁ ­ã´£³¡ªL«e½ú«ü¾É
¦A¦¸ÁÂÁ b9208«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«²ß±o«Ü¦hª¾ÃÑ,ÁÂÁ½׾Â
³o½d¨Ò¥Î¤F¦h­Ó°}¦C³B²z,ÀY¸£§Ö¥´µ²¤F,ÁÂÁÂ
°õ¦æ²Ó¸`»P¤ß±oµù¸Ñ¦p¤U,½Ð«e½ú¦A«ü¾É!ÁÂÁÂ

°õ¦æ«e:
2022-12-06_084509.JPG
2022-12-6 08:50


°õ¦æ«á:
2022-12-06_084532.JPG
2022-12-6 08:50


Option Explicit
Sub TEST_²Î­p_1()
Dim Arr, Xrr, Yrr, Zrr, xD, i&, U&, TT$, j%, T$(4), N&(3)
'¡ô«Å§i(Arr, Xrr, Yrr, Zrr, xD)¬O³q¥Î«¬ÅܼÆ,(i,U)¬Oªø¾ã¼Æ,
'(TT)¬O¦r¦êÅܼÆ,(j)¬Oµu¾ã¼Æ,(T)¬O5­Ó¦r¦êªº¤@ºû°}¦C,
'(N)¬O4­Óªø¾ã¼Æªº¤@ºû°}¦C

[²Î­p!c4:q3000].Delete Shift:=xlUp
'¡ô¥O"²Î­p" ¤u§@ªíªº [c4:q3000]Àx¦s®æ§R°£!
'ªÅ¦ì¥Ñ¤U¤èÀx¦s®æ©¹¤W»¼¸É
Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxD¬O¦r¨å
Arr = Range([Á`ªí!M1], [Á`ªí!G65536].End(xlUp))
'¡ô¥OArr¬O¦r¨å!­Ë¤J"Á`ªí"¤u§@ªí[M1]¨ì GÄæ³Ì«á¤@¦³¤º®eÀx¦s®æ½d³ò,
'ªºÀx¦s®æ­È
ReDim Xrr(1 To UBound(Arr), 1 To 4)
'¡ô«Å§iXrr¬O¤Gºû°}¦C!½d³ò¬O:
'Áa¦V±q1 ¨ìArr°}¦CÁa¦V³Ì¤j¦C¸¹¼Æ,¾î¦V±q1 ¨ì4

Yrr = Xrr
'¡ô¥OYrr ¤]¬O¤Gºû°}¦C!½d³ò¤j¤p¦P Xrr
Zrr = Xrr
'¡ô¥OZrr ¤]¬O¤Gºû°}¦C!½d³ò¤j¤p¦P Xrr
For i = 6 To UBound(Arr)
'¡ô³]¥~¶¶°j°é!i±q6 ¨ìArr°}¦CÁa¦V³Ì¤j¦C¸¹¼Æ
   T(1) = Arr(i, 1)
   '¡ô¥OT°}¦Cªº²Ä2­Ó¦r¦ê¬Oi°j°é¼Æ¦C²Ä1Ä檺Arr°}¦C­È
   T(2) = Arr(i, 3)
   '¡ô¥OT°}¦Cªº²Ä3­Ó¦r¦ê¬Oi°j°é¼Æ¦C²Ä3Ä檺Arr°}¦C­È
   T(3) = Arr(i, 4)
   '¡ô¥OT°}¦Cªº²Ä4­Ó¦r¦ê¬Oi°j°é¼Æ¦C²Ä4Ä檺Arr°}¦C­È
   T(4) = Arr(i, 7)
   '¡ô¥OT°}¦Cªº²Ä5­Ó¦r¦ê¬Oi°j°é¼Æ¦C²Ä7Ä檺Arr°}¦C­È
   '------------------------------

   TT = T(1) & "|" & T(2) & "|" & T(3)
   '¡ô¥OTT¦r¦êÅܼƬO T°}¦Cªº²Ä2~4­Ó¦r¦ê¤¤¶¡³s±µ"|"²Å¸¹ªº·s¦r¦ê
   U = xD(TT)
   '¡ô¥OU¬O ¥HTT¦r¦ê¬°key¬d¹îxD¦r¨åªºitem­È,
   '¤@¶}©lªºU­È³£¬Oªì©l­È0,¦]¬°¦b°j°é¤§«eU³£¨S¥X²{¹L

   If U = 0 Then
   '¡ô¦pªGU ¬O0 ??
      N(1) = N(1) + 1
      '¡ôif±ø¥ó¦¨¥ß!´NÅýªø¾ã¼ÆN°}¦Cªº²Ä2­Ó¼Æ¦r²Ö¥[1
      U = N(1)
      '¡ôif±ø¥ó¦¨¥ß!´NÅýU³oªø¾ã¼ÆÅÜ¼Æ¸Ë N°}¦Cªº²Ä2­Ó¼Æ¦r
      xD(TT) = U
      '¡ô¥OTT¦r¦êÅܼƬOkey,item¬OUªø¾ã¼ÆÅܼƭÈ!­Ë¤J¦r¨å¸Ì
      For j = 1 To 3
      '¡ô³]¤º¶¶°j°éj±q1 ¨ì3
         Xrr(U, j) = T(j)
         '¡ô¥OU¦Cj°j°éÄ檺Xrr°}¦C­È¬O T³o¤@ºû°}¦Cªº²Äj°j°é¼Æ¯Á¤Þ¦ì¸m¦r¦ê
      Next
   End If
   Xrr(U, 4) = Xrr(U, 4) + 1
   '¡ô¥OU¦C²Ä4Ä檺Xrr°}¦C­È²Ö¥[1
   '------------------------------

   TT = T(1) & "|" & T(4)
   '¡ô¥OTT¦r¦êÅܼƬOT°}¦C²Ä2­Ó¦r¦ê³s±µ"|"¦r¤¸,
   '¦A³s±µ T°}¦C²Ä5­Ó¦r¦êªº·s¦r¦ê

   U = xD(TT)
   '¡ô¥OU¬O ¥HTT¦r¦ê¬°key¬d¹îxD¦r¨åªºitem­È
   If U = 0 Then
   '¡ô¦pªGU ¬O0 ??
      N(2) = N(2) + 1
      '¡ôif±ø¥ó¦¨¥ß!´NÅýªø¾ã¼ÆN°}¦Cªº²Ä3­Ó¼Æ¦r²Ö¥[1
      U = N(2)
      '¡ôif±ø¥ó¦¨¥ß!´NÅýU³oªø¾ã¼ÆÅÜ¼Æ¸Ë N°}¦Cªº²Ä3­Ó¼Æ¦r
      xD(TT) = U
      '¡ô¥OTT¦r¦êÅܼƬOkey,item¬OUªø¾ã¼ÆÅܼƭÈ!­Ë¤J¦r¨å¸Ì
      Yrr(U, 1) = T(1)
      '¡ô¥OU¦C²Ä1Ä檺Yrr°}¦C­È¬O T°}¦Cªº²Ä2­Ó¦r¦ê
      Yrr(U, 2) = T(4)
      '¡ô¥OU¦C²Ä2Ä檺Yrr°}¦C­È¬O T°}¦Cªº²Ä5­Ó¦r¦ê
   End If
   Yrr(U, 3) = Yrr(U, 3) + 1
   '¡ô¥OU¦C²Ä3Ä檺Yrr°}¦C­È²Ö¥[1
   '------------------------------
   TT = T(1)
   '¡ô¥OTT¦r¦ê¬O T°}¦Cªº²Ä2­Ó¦r¦ê
   U = xD(TT)
   '¡ô¥OU¬O ¥HTT¦r¦ê¬°key¬d¹îxD¦r¨å±o¨ìªºitem­È
   If U = 0 Then
   '¡ô¦pªGU ¬O0 ??
      N(3) = N(3) + 1
      '¡ô¥ON°}¦Cªº²Ä4­Ó¼Æ¦r²Ö¥[1
      U = N(3)
      '¡ô¥OU ¬ON°}¦C¸Ìªº²Ä4­Ó¼Æ¦r
      xD(TT) = U
      '¡ô¥OTT¦r¦ê·íkey,U¼Æ¦r·íitem ­Ë¤Jxd¦r¨å¸Ì
      Zrr(U, 1) = T(1)
      '¡ô¥OU¦C²Ä1Ä檺Zrr°}¦C­È¬O T°}¦Cªº²Ä2­Ó¦r¦ê
   End If
   Zrr(U, 2) = Zrr(U, 2) + 1
   '¡ô¥OU¦C²Ä2Ä檺Zrr°}¦C­È²Ö¥[1
Next i
'------------------------------------
If N(1) > 0 Then
'¡ô¦pªGN°}¦C²Ä2­Ó¼Æ¦r ¤j©ó0 ??
   With [²Î­p!c4].Resize(N(1), 4)
   '¡ô¥H¤U¬OÃö©ó"²Î­p" ¤u§@ªí[C4]¦V¤UÂX®i(N°}¦C²Ä2­Ó¼Æ¦r)¦C¼Æ,
   '¦V¥kÂX®i4ÄæÀx¦s®æ½d³òªºµ{§Ç

      .Value = Xrr
      '¡ô¥OÂX®i½d³òÀx¦s®æ¥H Xrr°}¦Cª½¨ì¶i¥h
      .Borders.LineStyle = 1
      '¡ô¥OÂX®i½d³òÀx¦s®æªº®æ½u¼Ë¦¡¬O ²Ó¹ê½u
      .Sort key1:=.Item(1), Order1:=xlAscending, Header:=xlNo
      '¡ô³oÂX®i°Ï°ìÀx¦s®æ°µ¤@¼h¦¸ªº¾ã¦C±Æ§Ç,²Ó¸`¦p¤U:
         '±N³oÂX®i°Ï°ìÀx¦s®æªº¬Û¹ï²Ä1Äæ¦ì(ªí¸Ìªº CÄæ),°µ¤p¨ì¤jªº±Æ§Ç,
         '¨S¦³¼ÐÃD

   End With
End If
If N(2) > 0 Then
'¡ô¦pªGN°}¦C²Ä2­Ó¯Á¤Þ¦ì¸mªº¼Æ¦r­È ¤j©ó0 ??
   With [²Î­p!j4].Resize(N(2), 3)
   '¡ô¥H¤U¬OÃö©ó"²Î­p" ¤u§@ªí[J4]¦V¤UÂX®i(N°}¦C²Ä3­Ó¼Æ¦r)¦C¼Æ,
   '¦V¥kÂX®i3ÄæÀx¦s®æ½d³òªºµ{§Ç

      .Value = Yrr
      '¡ô¥OÂX®i½d³òÀx¦s®æ¥H Yrr°}¦Cª½¨ì¶i¥h
      .Borders.LineStyle = 1
      '¡ô¥OÂX®i½d³òÀx¦s®æªº®æ½u¼Ë¦¡¬O ²Ó¹ê½u
      .Sort key1:=.Item(1), Order1:=xlAscending, Header:=xlNo
      '¡ô³oÂX®i°Ï°ìÀx¦s®æ°µ¤@¼h¦¸ªº¾ã¦C±Æ§Ç,²Ó¸`¦p¤U:
       '±N³oÂX®i°Ï°ìÀx¦s®æªº¬Û¹ï²Ä1Äæ¦ì(ªí¸Ìªº JÄæ),°µ¤p¨ì¤jªº±Æ§Ç,
       '¨S¦³¼ÐÃD

   End With
End If
If N(3) > 0 Then
'¡ô¦pªGN°}¦C²Ä4­Ó¼Æ¦r ¤j©ó0 ??
   With [²Î­p!p4].Resize(N(3), 2)
   '¡ô¥H¤U¬OÃö©ó"²Î­p" ¤u§@ªí[P4]¦V¤UÂX®i(N°}¦C²Ä4­Ó¼Æ¦r)¦C¼Æ,
   '¦V¥kÂX®i2ÄæÀx¦s®æ½d³òªºµ{§Ç

      .Value = Zrr
      '¡ô¥OÂX®i½d³òÀx¦s®æ¥H Zrr°}¦Cª½¨ì¶i¥h
      .Borders.LineStyle = 1
      '¡ô¥OÂX®i½d³òÀx¦s®æªº®æ½u¼Ë¦¡¬O ²Ó¹ê½u
      .Sort key1:=.Item(1), Order1:=xlAscending, Header:=xlNo
      '¡ô³oÂX®i°Ï°ìÀx¦s®æ°µ¤@¼h¦¸ªº¾ã¦C±Æ§Ç,²Ó¸`¦p¤U:
       '±N³oÂX®i°Ï°ìÀx¦s®æªº¬Û¹ï²Ä1Äæ¦ì(ªí¸Ìªº PÄæ),°µ¤p¨ì¤jªº±Æ§Ç,
       '¨S¦³¼ÐÃD

   End With
End If
Set Arr = Nothing: Set Xrr = Nothing: Set Yrr = Nothing
Set Zrr = Nothing: Set xD = Nothing: Erase T, N
End Sub

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2022-12-6 11:51 ½s¿è

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


    ¦A¦¸ÁÂÁ ­ã´£³¡ªL«e½ú«ü¾É
¦A¦¸ÁÂÁ b9208«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«½m²ß¥H¦r¨åªº¤@ºû°}¦CITEMÂà¸m¦¨µ²ªG,±o«Ü¦hª¾ÃÑ,ÁÂÁ½׾Â
³o½d¨Ò¥Î ­ã´£³¡ªL«e½úªºµ{¦¡¬[ºc¦A¦h¤@­Ó¦r¨å»P¤@ºû°}¦C°µÅܤÆ,µ²ªGµy¦³¤£¦P
°õ¦æ²Ó¸`»P¤ß±oµù¸Ñ¦p¤U,½Ð«e½ú¦A«ü¾É!ÁÂÁÂ
°õ¦æ«á:
2022-12-06_112909.JPG
2022-12-6 11:36


Option Explicit
Sub TEST_Á`ªí_Âà¸m()
Dim Arr, Y, Z, Q, PH$, FN$, i&, j&, V$(14)
'¡ô«Å§i(Arr, Y, Z, Q)¬O³q¥Î«¬ÅܼÆ,(PH$, FN$)¬O¦r¦êÅܼÆ,(i,j)¬Oªø¾ã¼ÆÅܼÆ,
'V¬O15­Ó¤¸¯Àªº¤@ºû¦r¦ê°}¦CÅܼÆ

Dim xB As Workbook, xS As Worksheet, TT$, T$(4), M&
'¡ô«Å§i(xB)¬O¬¡­¶Ã¯ÅܼÆ,(xS)¬O¤u§@ªíÅܼÆ,
'(TT)¬O¦r¦êÅܼÆ,T¬O5­Ó¤¸¯Àªº¤@ºû¦r¦ê°}¦CÅܼÆ,(M&)¬Oªø¾ã¼ÆÅܼÆ

Set Y = CreateObject("Scripting.Dictionary")
Set Z = CreateObject("Scripting.Dictionary")
'¡ô¥OY,Z ¦U¬O¦r¨å
PH = ThisWorkbook.Path
'¡ô¥OPH¦r¦êÅܼƬO ²{¦b³o¬¡­¶Ã¯ªº©Ò¦bÀɮצì¸m
Call ²M°£_Á`ªí1
'¡ô°õ¦æ °Æµ{¦¡ ²M°£_Á`ªí1()
'--------------------------

Arr = Range([Á`ªí!a1], [Á`ªí!a65536].End(xlUp))
'¡ô¥OArr¬O°}¦C!­Ë¤J"Á`ªí"¤u§@ªí[A1]¨ì"Á`ªí"¤u§@ªíAÄæ³Ì«á¤@­Ó¦³¤º®eªºÀx¦s®æ
For i = 2 To UBound(Arr)
'¡ô³]¶¶°j°éi±q2 ¨ìArr°}¦CÁa¦V³Ì¤j¦C¸¹
    If Arr(i, 1) <> "" Then Y(Arr(i, 1) & "//a") = 1
    '¡ô¦pªGArr°}¦C°j°é¦C²Ä¤@Ä檺­È¤£¬O ªÅ¦r¤¸!
    '´N¥HArr°}¦C°j°é¦C²Ä¤@Ä檺­È ³s±µ "//a" ¦r¦ê ·íY¦r¨åªºKEY,
    'item¬O¼Æ¦r1

Next i
Application.ScreenUpdating = False
'¡ô¿Ã¹õµe­±¤£¸òµÛ°õ¦æµ{§ÇÅܤÆ
Do
'¡ô³]µL­­°j°é!¶}©l°õ¦æ«á­±ªºµ{§Ç,¦Û¤v·Q¿ìªk¸õ¥X°j°é
   If FN = "" Then
   '¡ô¦pªGFN¦r¦êÅܼƬO ªÅ¦r¤¸??
      FN = Dir(PH & "\*.xls")
      '¡ô¥OFN¦r¦êÅܼƬO ²{¦b³o¬¡­¶Ã¯ªº©Ò¦bÀɮצì¸mªºEXCELÀÉ®×
      Else
         FN = Dir
         '¡ôFN³v¦¸§ì¨ú¬Û¦P¸ô®|¤Uªº·í¦W
         'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/dir-function

   End If
   If FN = "" Then Exit Do
   '¡ô¦pªGFN¦r¦êÅܼƬOªÅ¦r¤¸!¥Nªí¬Û¦P¸ô®|¤UªºÀɦW¤w¸g³£§ì¹L¤F,´N¸õ¥XDo~Loopªº°j°é
   If FN = ThisWorkbook.Name Then GoTo DP
   '¡ô¦pªGFN¦r¦êÅܼƬO ²{¦b³o¬¡­¶Ã¯ªº¦WºÙ¦r¦ê!´N¸õ¨ì DP ¦ì¸mÄ~Äò°õ¦æ
   '--------------------------

   Set xB = Workbooks.Open(PH & "\" & FN, ReadOnly:=True)
   '¡ô¥OxB ¬O¥H°ßŪ¤è¦¡¥´¶} PH¦r¦êÅÜ¼Æ & "\" & FN¦r¦êÅܼƲզX¦¨¦r¦êªº¬¡­¶Ã¯
   Set xS = xB.Sheets(1)
   '¡ô¥OxS ¬O¥´¶}ªº³o¬¡­¶Ã¯ªº²Ä¤@­Ó¤u§@ªí
   Arr = Range(xS.[A1:O1], xS.UsedRange)
   '¡ô¥OArr­Ë±¼­ì¨Óªº°}¦C­È!Åܦ¨·s°}¦C,­Ë¤J¥´¶}ªº¬¡­¶Ã¯²Ä¤@­Óªí¥þ³¡¦³¨Ï¥ÎªºÀx¦s®æ­È
   'xS.UsedRange¦³¥i¯à¤£¥]§t³Ì¥ª¤W¨¤ªºÀx¦s®æ!©Ò¥H¥Î xS.[A1:O1]¦b«e¤è°µ§¹¾ã°Ï°ìÀx¦s®æ¦J¦C

   For i = 6 To UBound(Arr)
   '¡ô³]¥~¶¶°j°é!i±q6¨ìArr°}¦CÁa¦V³Ì¤j¦C¸¹
       T(1) = Arr(i, 6)
       '¡ô¥OT¤@ºû°}¦Cªº²Ä¤G­Ó¦r¦ê¬Oi°j°é¼Æ²Ä¤»ÄæArr°}¦C­È
       T(2) = Arr(i, 8)
       '¡ô¥OT¤@ºû°}¦Cªº²Ä¤T­Ó¦r¦ê¬Oi°j°é¼Æ²Ä¤KÄæArr°}¦C­È
       T(3) = Left(Arr(i, 9), 7)
       '¡ô¥OT¤@ºû°}¦Cªº²Ä¥|­Ó¦r¦ê¬Oi°j°é¼Æ²Ä¤EÄæArr°}¦C­Èªº¥ªÃä7­Ó¦r¤¸
       T(4) = Arr(i, 3)
       '¡ô¥OT¤@ºû°}¦Cªº²Ä¤­­Ó¦r¦ê¬Oi°j°é¼Æ²Ä¤TÄæArr°}¦C­È
       If T(1) = "" Or Y(T(1) & "//a") = 0 Then
       '¡ô¦pªGT°}¦Cªº²Ä¤G­Ó¦r¦ê¬O ªÅ¦r¤¸ ©Î
       '¥H T°}¦Cªº²Ä¤G­Ó¦r¦ê³s±µ "//a"¦r¦ê¬d¹îY¦r¨å ¬O0??

          GoTo 101
          '¡ô±ø¥ó¦¨¥ß!´N¸õ¨ì 101ªº¦ì¸mÄ~Äò°õ¦æ
       End If
       TT = T(1) & "|" & T(2) & "|" & T(3) & "|" & T(4)
       '¡ô¥OTT¦r¦êÅܼƬOT°}¦C¸Ì²Ä¤G­Ó¦r¦ê¨ì²Ä¤­­Ó¦r¦ê¤¤¶¡³s±µ"|"²Å¸¹ªº¦r¦ê
       If Y.Exists(TT) = Empty Then
       '¡ô¦pªG ¥ÎTT¦r¦êÅܼƬd¹îY¦r¨å¨S¦³³o­Ókey
          Y(TT) = Arr(i, 11)
          '¡ô¥OTT¦r¦êÅܼƬOkey,item¬O°j°é¦C¼Æ²Ä11Ä檺Arr°}¦C­È,­Ë¤JY¦r¨å¸Ì
          ElseIf Arr(i, 11) > Y(TT) Then
          '¡ô§_«h¦pªG °j°é¦C¼Æ²Ä11Ä檺Arr°}¦C­È ¤j©ó (TT·íkey¬d¹îY¦r¨åªºitem­È)
              Y(TT) = Arr(i, 11)
              '¡ô¥OTT¦r¦êÅܼƬOkey,item¬O°j°é¦C¼Æ²Ä11Ä檺Arr°}¦C­È,­Ë¤JY¦r¨å¸Ì,
              '¦pªGkey­«½Æ!´N±Nitem¸m´«¦¨·sªº

              Z.Remove TT
              '¡ô¥OZ¦r¨å§R°£ TT¦r¦êÅܼƪºkey»Pitem
              M = M - 1
              '¡ô¥OM´î±¼ 1
       End If
       If Z.Exists(TT) = Empty Then
          M = M + 1
          '¡ô¥OM²Ö¥[1
          Q = V
          '¡ô¥OQ ¬OV¤@ºû°}¦C
          For j = 0 To UBound(Q)
          '¡ô³]¤º¶¶°j°é!j±q0 ¨ìQ°}¦C¾î¦V³Ì¤jÄ渹
             Q(j) = Arr(i, j + 1)
             '¡ô¥O j¤º°j°é¯Á¤Þ¸¹ªºQ°}¦C­È = ¥~°j°éi¦C¸¹ j+1¤º°j°éÄ渹ªºArr°}¦C­È
          Next
          Q(8) = Left(Q(8), 7)
          '¡ô8¯Á¤Þ¸¹ªºQ°}¦C­È = ¦Û¤vªº­È¨ú¥ª°¼ªº7 ­Ó¦r¤¸
          Z(TT) = Q
          '¡ô¥OTT¦r¦êÅܼƬ°key,Item¬OQ¤@ºû°}¦C
       End If
101: Next i
   xB.Close 0
   '¡ôÃö³¬³Q¶}±Òªº xB¬¡­¶Ã¯ÅܼÆÀÉ®×(¤£¦sÀÉ)
DP: Loop
'¡ôµL­­°j°éªºÂà§éÂI!¸õ¨ì«e­±ªºDo¦ì¸mÄ~Äò°õ¦æ!
'--------------------------

If M > 0 Then
'¡ô¦pªGM¾ã¼ÆÅܼƤj©ó0 (³o¸ÌªºM «üªº¬O Z¦r¨åkey¼Æ¶q)
   With [Á`ªí!b6].Resize(M, UBound(V) + 1)
   '¡ô¥H¤UÃö©ó "Á`ªí"¤u§@ªí[B6]¦V¤UÂX®iM¦C,¦V¥kÂX®iQ°}¦C³Ì¤j¯Á¤Þ¸¹+1¼ÆÄæ ªºÀx¦s®æ°Ï°ì
         .Value = Application.Transpose(Application.Transpose(Z.items))
         '¡ô³oÂX®i°Ï°ìÀx¦s®æ¥HZ¦r¨åªºitemsÂà¸m¨â¦¸ªº­È­Ë¤J
         .Borders.LineStyle = 1
         '¡ô¥O³oÂX®i°Ï°ìÀx¦s®æªº®æ½u¼Ë¦¡¬O ²Ó¹ê½u
         .Sort key1:=.Item(3), Order1:=xlAscending, _
               key2:=.Item(8), Order2:=xlAscending, Header:=xlNo
         '¡ô³oÂX®i°Ï°ìÀx¦s®æ°µ¨â¼h¦¸ªº¾ã¦C±Æ§Ç,²Ó¸`¦p¤U:
         '1.±N³oÂX®i°Ï°ìÀx¦s®æªº¬Û¹ï²Ä¤TÄæ¦ì(ªí¸Ìªº DÄæ),°µ¤p¨ì¤jªº±Æ§Ç
         '2.¨Ã±N¤@¦¸±Æ§Ç«á¸Ì­±¬Û¦P­Èªº¬Û¹ï²Ä¤KÄæ¦ì(ªí¸Ìªº IÄæ),°µ¤p¨ì¤jªº±Æ§Ç

   End With
End If
Set Arr = Nothing: Set Y = Nothing: Set Z = Nothing
Erase V, T, Q
End Sub
Sub ²M°£_Á`ªí1()
Sheets("Á`ªí").UsedRange.Offset(5, 0).Offset(, 1).Delete Shift:=xlUp
'¡ô"Á`ªí"¤u§@ªí¦³¨Ï¥ÎªºÀx¦s®æ½d³ò,©¹¤U°¾²¾5¦C,¥ª¥k¤£°¾²¾,¤§«á¦A©¹¥k°¾²¾1Äæ,
'¦¹Àx¦s®æ½d³ò§R°£!¨Ã¥Ñ¤U¤èªºÀx¦s®æ©¹¤W»¼¸É

'Offset(5, 0).Offset(, 1) = Offset(5, 0).Offset(0 , 1)
'Offset(5, 0).Offset(, 1) = Offset(5).Offset( , 1)
'Offset(5, 0).Offset(, 1) = Offset(5, 1)
'Offset(5,  ).Offset(, 1) ·|¥X²{ ½sĶ¿ù»~
'https://learn.microsoft.com/zh-tw/office/vba/api/excel.range.offset

End Sub

TOP

        ÀR«ä¦Û¦b : °ß¨ä´L­«¦Û¤vªº¤H¡A¤~§ó«i©óÁY¤p¦Û¤v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD