Hsieh

¦^´_ 1# basarasy
²q·Q¬O³o¼Ëªº·N«ä

1. Sub Ex()
   
2. Dim Ar(), Ay(), Rng As Range, A As Range, s%, j%
   
3. Set Rng = [A1:G1]
   
4. For Each A In Rng
   
5.    If A = Application.Max(Rng) Then
   
6.       ReDim Preserve Ar(s)
   
7.       ReDim Preserve Ay(s)
   
8.       Ar(s) = A.Address
   
9.       Ay(s) = A.Column
   
10.       s = s + 1
    
11.    End If
    
12. Next
    
13. [H1].Resize(, s) = Ay: s = 0: Erase Ar
    
14. Set Rng = Nothing
    
15. For j = 0 To UBound(Ay)
    
16.    If Rng Is Nothing Then Set Rng = Cells(2, Ay(j)) Else Set Rng = Union(Rng, Cells(2, Ay(j)))
    
17. Next
    
18. For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    
19.     For Each A In Rng
    
20.         If A = Application.Min(Rng) Then
    
21.            ReDim Preserve Ar(s)
    
22.            ReDim Preserve Ay(s)
    
23.            Ar(s) = A.Address
    
24.            Ay(s) = A.Column
    
25.            s = s + 1
    
26.         End If
    
27.     Next
    
28.     Cells(r, "H").Resize(, s) = Ay
    
29. For j = 0 To UBound(Ay)
    
30.    Set Rng = Union(Rng, Cells(2, Ay(j)))
    
31. Next
    
32. s = 0: Erase Ay: Erase Ar
    
33. Next
    
34. End Sub

½Æ»s¥N½X

¥t¥~¥Î¼Æ¦r¥N´ÀÄæ¦ìOKªº
Columns(1).Delete

Hsieh

¦^´_ 3# basarasy
¸Õ¸Õ¬Ý

1. Sub Ex()
   
2. Dim Ar(), Ay(), Rng As Range, A As Range, s%, j%
   
3. Set Rng = [A1:G1]
   
4. For Each A In Rng
   
5.    If A = Application.Max(Rng) Then '¦pªG¬O³Ì¤j­È
   
6.       ReDim Preserve Ar(s)
   
7.       ReDim Preserve Ay(s)
   
8.       Ar(s) = A.Address '°O¦í¦ì§}
   
9.       Ay(s) = A.Column '°O¦íÄæ¦ì
   
10.       s = s + 1
    
11.    End If
    
12. Next
    
13. s = 0: Erase Ar
    
14. Set Rng = Nothing
    
15. For j = 0 To UBound(Ay) '³Ì¤j­Èªº¤U¤@®æÀx¦s®æÁp¶°
    
16.    If Rng Is Nothing Then Set Rng = Cells(2, Ay(j)) Else Set Rng = Union(Rng, Cells(2, Ay(j)))
    
17. Next
    
18. For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row '²Ä2¦C¥H¤U°j°é
    
19.     For Each A In Rng
    
20.         If A = Application.Min(Rng) Then '¦pªG¬O³Ì¤p­È
    
21.            ReDim Preserve Ar(s)
    
22.            ReDim Preserve Ay(s)
    
23.            Ar(s) = A.Address '°O¦í¦ì§}
    
24.            Ay(s) = A.Column '°O¦íÄæ¦ì
    
25.            s = s + 1
    
26.         End If
    
27.     Next
    
28.     Set Rng = Nothing
    
29. For j = 0 To UBound(Ay)
    
30.    If Rng Is Nothing Then Set Rng = Cells(r, Ay(j)) Else Set Rng = Union(Rng, Cells(r, Ay(j)))
    
31. Next
    
32. ck = Ay(0)
    
33. s = 0: Erase Ay: Erase Ar
    
34. Next
    
35. [H1] = ck
    
36. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 5# basarasy

1. Sub Ex()
   
2. Dim Ar(), Ay(), Rng As Range, A As Range, s%, j%
   
3. Set Rng = [A1:G1]
   
4. For Each A In Rng
   
5.    If A = Application.Max(Rng) Then '¦pªG¬O³Ì¤j­È
   
6.       ReDim Preserve Ar(s)
   
7.       ReDim Preserve Ay(s)
   
8.       Ar(s) = A.Address '°O¦í¦ì§}
   
9.       Ay(s) = A.Column '°O¦íÄæ¦ì
   
10.       s = s + 1
    
11.    End If
    
12. Next
    
13. For j = 0 To UBound(Ay) '³Ì¤j­Èªº¤U¤@®æÀx¦s®æÁp¶°
    
14.    If Rng Is Nothing Then Set Rng = Cells(2, Ay(j)) Else Set Rng = Union(Rng, Cells(2, Ay(j)))
    
15. Next
    
16. For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row '²Ä2¦C¥H¤U°j°é
    
17. s = 0: Erase Ar
    
18. Set Rng = Nothing
    
19. For j = 0 To UBound(Ay)
    
20.    If Rng Is Nothing Then Set Rng = Cells(r, Ay(j)) Else Set Rng = Union(Rng, Cells(r, Ay(j)))
    
21. Next
    
22. s = 0: Erase Ay: Erase Ar
    
23.     For Each A In Rng
    
24.         If A = Application.Min(Rng) Then '¦pªG¬O³Ì¤p­È
    
25.            ReDim Preserve Ar(s)
    
26.            ReDim Preserve Ay(s)
    
27.            Ar(s) = A.Address '°O¦í¦ì§}
    
28.            Ay(s) = A.Column '°O¦íÄæ¦ì
    
29.            s = s + 1
    
30.         End If
    
31.     Next
    
32.     Set Rng = Nothing
    
33.     ck = Ay(0)
    
34. Next
    
35. [H1] = ck
    
36. End Sub

½Æ»s¥N½X