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

[µo°Ý] ¦h¤u§@ªí¦X¨Ö¶×ºâ

[µo°Ý] ¦h¤u§@ªí¦X¨Ö¶×ºâ

¥»©«³Ì«á¥Ñ dou10801 ©ó 2023-10-7 14:46 ½s¿è

½Ð±Ð¦U¦ì¥ý¶i,¦h¤u§@ªí¦X¨Ö¶×ºâ,¦P¤@[½s¸¹]¬°¦ó¤£¯à¥[Á`²Î­p.

µû¤Àªí.rar (39.11 KB)

§ù¤p¥­

¦^´_ 6# Andy2483


    ¥H¤U¬O½Æ²ß¤ß±oµù¸Ñ

Option Explicit
Sub ¸ü¤J_1()
Dim Arr, Brr(1 To 14), Z, A, T$, i&, j%, q%
'¡ô«Å§iÅܼÆ:(Arr,Z,A)¬O³q¥Î«¬ÅܼÆ,T¬O¦r¦êÅܼÆ,(i)¬Oªø¾ã¼Æ
'(j,q)¬Oµu¾ã¼Æ,Brr¬O¤@ºûªÅ°}¦C,¯Á¤Þ¸¹1~14

Sheets("¶×Á`").UsedRange.Offset(4).ClearContents
'¡ô¥O"¶×Á`"¤u§@ªí¤¤²[»\¤w¨Ï¥ÎÀx¦s®æªº³Ì¤p¤è¥¿°Ï°ìÀx¦s®æ½d³ò,
'¦¹½d³ò¦V¤U°¾²¾4¦Cªº·s½d³ò²M°£¤º®e

Set Z = CreateObject("Scripting.Dictionary")
'¡ô¥OZ³o³q¥Î«¬ÅܼƬO ¦r¨å
For q = 1 To Sheets.Count
'¡ô³]¶¶°j°é!¥Oq³oµu¾ã¼Æ±q1 ¨ì³o¬¡­¶Ã¯ªº¤u§@ªí¼Æ¶q¼Æ
   If Trim(Sheets(q).[A5]) = "" Then GoTo q01
   '¡ô¦pªGq°j°é¼Æ¤u§@ªíªº[A5]Àx¦s®æ­È¥h°£ÀY§ÀªÅ¦r¤¸«áªº·s¦r¦ê¬OªÅ¦r¤¸,
   '¦pªG¬OªÅ¦r¤¸´N¸õ¨ì¼Ð¥Ü q01¦ì¸mÄ~Äò°õ¦æ

   Arr = Range(Sheets(q).[n1], Sheets(q).[a65536].End(3))
   '¡ô¥OArr³o³q¥Î«¬ÅܼƬO¤Gºû°}¦C,¥Hq°j°é¯Á¤Þ¸¹¤u§@ªíªº[N1]¨ìAÄæ³Ì«á¦³¤º®eÀx¦s®æ,
   '¥O³oÀx¦s®æ½d³ò­È±a¤JArr°}¦C¤¤

   For i = 5 To UBound(Arr)
   '¡ô³]¶¶°j°é!¥OiÅܼƱq1¨ì Arr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
      T = Trim(Arr(i, 1)) & "|" & Trim(Arr(i, 2))
      '¡ô¥OT³o¦r¦êÅܼƬO ¥H"|"²Å¸¹³s±µi¦C1/2ÄæArr°}¦C­È¥h°£ÀY§ÀªÅ¥Õ¦r¤¸ªº²Õ¦X·s¦r¦ê
      A = Z(T)
      '¡ô¥OA³o³q¥Î«¬ÅܼƬO ¥HTÅܼƬdZ¦r¨å±a¥X¨Óªºitem
      If Not IsArray(A) Then
      '¡ô¦pªGAÅܼƤ£¬O°}¦C??
         A = Brr
         '¡ô¥OAÅܼƬO ¦PBrr°}¦C¤j¤pªº¤@ºûªÅ°}¦C
         A(1) = Trim(Arr(i, 1)): A(2) = Trim(Arr(i, 2))
         '¡ô¥OA°}¦C1¯Á¤Þ¸¹°}¦C­È¬O i°j°é¦C1ÄæArr°}¦C­È,¥h°£ÀY§ÀªÅ¥Õ¦r¤¸ªº·s¦r¦ê
         '¡ô¥OA°}¦C2¯Á¤Þ¸¹°}¦C­È¬O i°j°é¦C2ÄæArr°}¦C­È,¥h°£ÀY§ÀªÅ¥Õ¦r¤¸ªº·s¦r¦ê

      End If
      For j = 3 To UBound(Arr, 2)
      '¡ô³]¶¶°j°é!¥OjÅܼƱq3¨ì Arr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹¼Æ
         A(j) = A(j) + Val(Arr(i, j))
         '¡ô¥OA°}¦Cj°j°é¼Æ¯Á¤Þ¸¹°}¦C­È¬O ²Ö¥[i°j°é¦Cj°j°éÄæArr°}¦C­ÈÂà¤Æ¦¨ªº¼Æ­È
      Next
      Z(T) = A
      '¡ô¥OTÅܼÆkey¥H ·sªºA°}¦C©ñ¦^Z¦r¨å¤¤
   Next
q01: Next
'------------------------------
With Sheets("¶×Á`").[A5].Resize(Z.Count, 14)
'¡ô¥H¤U¬OÃö©ó"¶×Á`"¤u§@ªíªº[A5]ÂX®i¦V¤UZ¦r¨åkey¼Æ¦C,ÂX®i¦V¥k14Äæ½d³òÀx¦s®æ,
'Ãö©ó¦¹½d³òÀx¦s®æµ{§Ç

   .Value = Application.Transpose(Application.Transpose(Z.Items))
   '¡ô¥O¸Ó½d³òÀx¦s®æ­È¥HZ¦r¨åitemÂà¸m¨â¦¸ªº°}¦C­È±a¤J
   .Sort KEY1:=.Item(1), Order1:=1, KEY2:=.Item(2), Order1:=1, Header:=2
   '¡ô¥O¸Ó½d³òÀx¦s®æ°µ2¼h¦¸µL¼ÐÃD¦Cªº¥¿±Æ§Ç,²Ä1¼h¬O²Ä1Äæ,²Ä2¼h¬O²Ä2Äæ
   .Columns(7) = "=rank(F5," & .Columns(6).Address(1, 1) & ")"
   '¡ô¥O²Ä7Äæ­È¬O ²Ä6Ä檺±Æ¦W¤½¦¡
   .Columns(14) = "=rank(M5," & .Columns(13).Address(1, 1) & ")"
   '¡ô¥O²Ä14Äæ­È¬O ²Ä13Ä檺±Æ¦W¤½¦¡
End With
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
¥H¤U¬O¥H ­ã´£³¡ªL«e½úªº½d¨Ò¼ÒÀÀ¤£¦P±¡¹Ò»Ý¨D,§ï¥H¦r¨å¤¤ªº¤@ºû°}¦C¤è¦¡ªº½m²ß,½Ð¦U¦ì«e½ú«ü±Ð

¬Û¦Pªº°õ¦æµ²ªG:



Option Explicit
Sub ¸ü¤J_1()
Dim Arr, Brr(1 To 14), Z, A, T$, N&, i&, j%, q%
Sheets("¶×Á`").UsedRange.Offset(4).ClearContents
Set Z = CreateObject("Scripting.Dictionary")
For q = 1 To Sheets.Count
   If Trim(Sheets(q).[A5]) = "" Then GoTo q01
   Arr = Range(Sheets(q).[n1], Sheets(q).[a65536].End(3))
   For i = 5 To UBound(Arr)
      T = Trim(Arr(i, 1)) & "|" & Trim(Arr(i, 2))
      A = Z(T)
      If Not IsArray(A) Then
         A = Brr
         A(1) = Trim(Arr(i, 1)): A(2) = Arr(i, 2)
      End If
      For j = 3 To UBound(Arr, 2)
         A(j) = A(j) + Val(Arr(i, j))
      Next
      Z(T) = A
   Next
q01: Next
'------------------------------
With Sheets("¶×Á`").[A5].Resize(Z.Count, 14)
   .Value = Application.Transpose(Application.Transpose(Z.Items))
   .Sort KEY1:=.Item(1), Order1:=1, KEY2:=.Item(2), Order1:=1, Header:=2
   .Columns(7) = "=rank(F5," & .Columns(6).Address(1, 1) & ")"
   .Columns(14) = "=rank(M5," & .Columns(13).Address(1, 1) & ")"
End With
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-10-11 09:59 ½s¿è

¦^´_ 1# dou10801
¦^´_ 3# ­ã´£³¡ªL


    ÁÂÁ dou10801«e½úµoªí¦¹¥DÃD»P½d¨Ò
ÁÂÁ ­ã´£³¡ªL«e½ú«ü¾É
¥H¤U¬O«á¾Ç¾Ç²ß¾Ç¤ß±oµù¸Ñ,½Ð«e½ú¦A«ü¾É

Sub ¸ü¤J()
Dim Arr, Brr, xD, T$, R&, N&, i&, j%, S As Worksheet
'¡ô«Å§iÅܼÆ:(Arr, Brr, xD)¬O³q¥Î«¬ÅܼÆ,T¬O¦r¦êÅܼÆ,(R,N,i)¬Oªø¾ã¼Æ
'j¬Oµu¾ã¼Æ,S¬O¤u§@ªíÅܼÆ

ReDim Brr(1 To 30000, 1 To 14)
'¡ô«Å§iBrrÅܼƬO¤Gºû°}¦C,Áa¦V½d³ò±q¯Á¤Þ¸¹1¨ì30000,¾î¦V½d³ò±q1¯Á¤Þ¸¹¨ì14
Call ²M°£
'¡ô¥O°õ¦æ°Æµ{¦¡ Sub ²M°£()
Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxD¬O¦r¨å
For Each S In Sheets
'¡ô³]³v¶µ°j°é!¥OSÅܼƬO¬¡­¶Ã¯¸Ìªº¤u§@ªí
    If S.Name = "¶×Á`" Then GoTo s01
    '¡ô¦pªGSÅܼƤu§@ªí¦W¦r¬O "¶×Á`" ,´N¸õ¨ì¼Ð¥Ü s01 ¦ì¸mÄ~Äò°õ¦æ
    Arr = Range(S.[n1], S.[a65536].End(3))
    '¡ô¥OArrÅܼƬO¤Gºû°}¦C,¥HSÅܼƤu§@ªíªº[N1]¨ìAÄæ³Ì«á¦³¤º®eÀx¦s®æ,
    '¥O³oÀx¦s®æ½d³ò­È±a¤JArr°}¦C¤¤

    For i = 5 To UBound(Arr)
    '¡ô³]¶¶°j°é±q5 ¨ìArr°}¦C³Ì¤j¯Á¤Þ¦C¸¹
        T = Arr(i, 1): R = xD(T)
        '¡ô¥OT³o¦r¦êÅܼƬOi°j°é¦C²Ä1ÄæArr°}¦C­È
        '¥OR³oªø¾ã¼ÆÅܼƬO¥HTÅܼƬdxD¦r¨åitem­È(¦¹key©Ò¦bªºBrr°}¦C¦C¸¹)

        If R = 0 Then
        '¡ô¦pªGRÅܼƭȬO0 (¥Nªí¦¹key­º¦¸¯Ç¤JxD¦r¨å¤¤)
           N = N + 1: R = N: xD(T) = N
           '¡ô¥ON³oªø¾ã¼ÆÅܼƲ֥[1 (³o¬O­n°O¿ýBrr°}¦C¥Î¨ì¤F²Ä´X¦C)
           '¥ORÅÜ¼Æ­È = NÅܼƭÈ(·N«ä¬O¦¹key­n©ñ¦bBrrªºNÅܼƦC)
           '¥OxD¦r¨å¤¤TÅܼÆkeyªºitem­È´«¦¨NÅܼƭÈ(³o¬O­n°O¿ý¦¹key¦bBrrªº¦C¸¹)

           Brr(N, 1) = T: Brr(N, 2) = Arr(i, 2)
           '¡ô¥ONÅܼƦC²Ä1ÄæBrr°}¦C­È¬OTÅܼÆ
        End If
        For j = 3 To UBound(Arr, 2)
        '¡ô³]¶¶°j°é±q3 ¨ìArr°}¦C³Ì¤j¯Á¤ÞÄ渹
            Brr(R, j) = Brr(R, j) + Val(Arr(i, j))
            '¡ô¥ORÅܼƦCj°j°éÄæBrr°}¦C­È ²Ö¥[Val¨ç¼Æ­È(i°j°é¦Cj°j°éÄæArr°}¦C­È)
        Next j
    Next i
s01: Next
'------------------------------
With Sheets("¶×Á`").[a5].Resize(N, 14)
'¡ô¥H¤U¬OÃö©ó¤u§@ªí"¶×Á`" ªº[A5]Àx¦s®æ¦V¤UÂX®iNÅܼƦC,¦V¥kÂX®i14Ä檺Àx¦s®æ½d³òµ{§Ç
     .Value = Brr
     '¡ô¥O¸Ó½d³òÀx¦s®æ­È¥HBrr°}¦C­È±a¤J
     .Columns(7) = "=rank(f5," & .Columns(6).Address & ")"
     '¡ô¥O²Ä7Äæ­È¬O ²Ä6Ä檺±Æ¦W
     .Columns(14) = "=rank(M5," & .Columns(13).Address & ")"
     '¡ô¥O²Ä14Äæ­È¬O ²Ä13Ä檺±Æ¦W
End With
End Sub

Sub ²M°£()
Sheets("¶×Á`").UsedRange.Offset(4).ClearContents
'¡ô¥O"¶×Á`" ¤u§@ªí¦³¨Ï¥ÎªºÀx¦s®æ¦V¤U°¾²¾4¦Cªº½d³òÀx¦s®æ²M°£¤º®e
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 3# ­ã´£³¡ªL [/b·PÁÂ,­ã´£³¡ªL,ª©¥D«ü¾É,¾Ç¨ì·sªº¤èªk.
§ù¤p¥­

TOP

­«¼g//
Sub ¸ü¤J()
Dim Arr, Brr, xD, T$, R&, N&, i&, j%, S As Worksheet
ReDim Brr(1 To 30000, 1 To 14)
Call ²M°£
Set xD = CreateObject("Scripting.Dictionary")
For Each S In Sheets
    If S.Name = "¶×Á`" Then GoTo s01
    Arr = Range(S.[n1], S.[a65536].End(3))
    For i = 5 To UBound(Arr)
        T = Arr(i, 1): R = xD(T)
        If R = 0 Then
           N = N + 1: R = N: xD(T) = N
           Brr(N, 1) = T: Brr(N, 2) = Arr(i, 2)
        End If
        For j = 3 To UBound(Arr, 2)
            Brr(R, j) = Brr(R, j) + Val(Arr(i, j))
        Next j
    Next i
s01: Next
'------------------------------
With Sheets("¶×Á`").[a5].Resize(N, 14)
     .Value = Brr
     .Columns(7) = "=rank(f5," & .Columns(6).Address & ")"
     .Columns(14) = "=rank(M5," & .Columns(13).Address & ")"
End With
End Sub

Sub ²M°£()
Sheets("¶×Á`").UsedRange.Offset(4).ClearContents
End Sub


Xl0000040.rar (20.35 KB)

TOP

¦^´_ 1# dou10801 ·Q­nªºµ²ªG.

µû¤Àªí1.rar (41.62 KB)

§ù¤p¥­

TOP

        ÀR«ä¦Û¦b : ¡i°±º¢¤£«e¡A²×µL©Ò±o¡j¤H³£°g©ó´M§ä©_ÂÝ¡A¦]¦Ó°±º¢¤£«e¡FÁa¨Ï®É¶¡¦A¦h¡B¸ô¦Aªø¡A¤]¤FµL¥Î³B¡A²×µL©Ò±o¡C
ªð¦^¦Cªí ¤W¤@¥DÃD