| ©«¤l5923 ¥DÃD13 ºëµØ1 ¿n¤À5986 ÂI¦W0  §@·~¨t²Îwin10 ³nÅ骩¥»Office 2010 ¾\ŪÅv150 ©Ê§O¨k ¨Ó¦Û¥xÆW°ò¶© µù¥U®É¶¡2010-5-1 ³Ì«áµn¿ý2022-1-23 
         
 | 
                
| ¥»©«³Ì«á¥Ñ GBKEE ©ó 2010-6-10 07:17 ½s¿è 
 ¦^´_ 3# myleoyes
 ½Æ»s¥N½XSub ¤ñ¹ï³Æ¥÷()
    Dim d As Object, Rng As Range, E As Range, M%, R, i%
    Set d = CreateObject("Scripting.Dictionary")
    With Sheets("¤ñ¹ï³Æ¥÷")
        If .Range("iv1").End(xlToLeft).Column > 1 Then '¤w¦³³Æ¥÷¸ê®Æ
            Set Rng = .Range("B1", .Range("iv1").End(xlToLeft))  '³Æ¥÷¸ê®ÆÄæ¦ì½d³ò
            Set E = Rng(1, Rng.Columns.Count + 1)   '³]¥ßn¥[¤J³Æ¥÷¸ê®ÆÄæ¦ìªº¦ì¸m
            M = Application.Max(Rng)                '¨ú±o¤w¦³³Æ¥÷¸ê®Æ¤¤²Ä1¦C¤º¬Û¦P¶µ¥Øªº³Ì¤j¼Æ
        Else                                        '¨S¦³³Æ¥÷¸ê®Æ
            Set E = .Range("B1")
            M = 0
        End If
    End With
    Set Rng = Range("A1").CurrentRegion
    Set Rng = Range("C1", Rng(Rng.Rows.Count, Rng.Columns.Count)) '³Æ¥÷¸ê®Æªº½d³ò
    i = 1
    For Each R In Rng.Rows(1).Cells
        If Not d.Exists(R.Value) Then
            d(R.Value) = i   '³]©w½Æ»s¸ê®Æ¤º²Ä1¦C¬Û¦P¶µ¥Øªº¼ÆÈ
            i = i + 1
        End If
    Next
    Rng.Copy E
    i = 0
    Do While E.Offset(, i) <> ""
        If d.Exists(E.Offset(, i).Value) Then E.Offset(, i) = d(E.Offset(, i).Value) + M
        '×§ï½Æ»s¸ê®Æ«á ²Ä1¦C¬Û¦P¶µ¥Ø·s¼Wªº¼ÆÈ
        '->³]©w½Æ»s¸ê®Æ¤º²Ä1¦C¬Û¦P¶µ¥Øªº¼ÆÈ + ¤w¦³³Æ¥÷¸ê®Æ¤¤²Ä1¦C¤º¬Û¦P¶µ¥Øªº³Ì¤j¼Æ
        i = i + 1
    Loop
End Sub
 | 
 |