©â¼úªº¥¨¶°

yeh6712

¦p¹Ï¡AAÄ榳10­Ó¤H(A¡ãJ)¡ABÄ榳4­Óª««~(1¡ã4)¡A
10­Ó¤H­n©â³o4­Óª««~¡A½Ð°Ý¦p¦ó¥Î¥¨¶°¡A¦bCÄ椤Åã¥Ü©â¤¤ªº¤Hªºª««~¸¹½X¡HÁÂÁ¡K¡I
  

¤U¸ü (20.56 KB)

2014-1-10 17:00

stillfish00

¦^´_ 1# yeh6712
¥ÎVBA®É¡A¦]¬°Rank²Ä¤G°Ñ¼Æ¦n¹³¤£¤ä´©array§Î¦¡¡A©Ò¥H¹³¤U­±³o¼ËÅo¶Û¤F¤@ÂI
ª««~Äæ¤]¥i¥H¤£¥Î¼Æ¦r

1. Sub TEST()
   
2.   Dim rngTest As Range, rngB As Range, ar, i
   
3.   
   
4.   With ActiveSheet
   
5.     Set rngTest = .Range(.[A2], .Cells(.Rows.Count, "A").End(xlUp)).Offset(, 2)
   
6.     Set rngB = .Range(.[B2], .Cells(.Rows.Count, "B").End(xlUp))
   
7.    
   
8.     Randomize Now
   
9.     For i = 1 To rngTest.Count
   
10.       rngTest(i).Value = Rnd
    
11.     Next
    
12.    
    
13.     ReDim ar(1 To rngTest.Count)
    
14.     For i = LBound(ar) To UBound(ar)
    
15.       ar(i) = Application.WorksheetFunction.Rank(rngTest(i).Value, rngTest)
    
16.       ar(i) = IIf(ar(i) > rngB.Count, "", rngB(ar(i)))
    
17.     Next
    
18.    
    
19.     rngTest.Value = Application.Transpose(ar)
    
20.   End With
    
21. End Sub

½Æ»s¥N½X

yeh6712

¦^´_ 2# stillfish00

·PÁ¡K¡I¤Ó¼F®`¤F¡K
¬ÝÀ´¤F¡A¬O§â©Ò±oªº¶Ã¼Æ­È±Æ§Ç«á¡A¦A¶ñ¤W±Æ§Ç­È¡A±Æ§Ç­È¶W¹LBÄæ­Ó¼Æ¡A´N¶ñªÅ®æ¡A¹ï¶Ü¡H

¥t¤@°Ý¡G¦pªG·Q§â©â¤¤¤H­ûª½±µ¼g¦b¦U­Ó¸¹½X¥kÃ䪺Äæ¦ì¡A¨º¦p¦ó­×§ï©O¡HÁÂÁ¡K¡]¦pªþ¹Ï¡^

¤U¸ü (6.62 KB)

2014-1-18 21:55

stillfish00

¦^´_ 3# yeh6712
·s¼W¤@¦æ´N¦n
    For i = LBound(ar) To UBound(ar)
        ar(i) = Application.WorksheetFunction.Rank(rngTest(i).Value, rngTest)
        rngB(ar(i)).Offset(, 2).Value = IIf(ar(i) > rngB.Count, "", rngTest(i).Offset(, -2).Value)
        ar(i) = IIf(ar(i) > rngB.Count, "", rngB(ar(i)))
    Next

yeh6712

¦^´_ 4# stillfish00

¤Ó´Î¤F¡K¯u·PÁ¡A¤pªº¦A¦n¦n¬ã¨s¤@¤U¡K

Hsieh

¦^´_ 3# yeh6712

1. Sub ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. s = Application.CountA([A:A]) - 1
   
4. UsedRange.Offset(1, 2) = ""
   
5. For i = 1 To Application.CountA([B:B]) - 1 '¼ú¶µ
   
6.     Do
   
7.        j = Int((s * Rnd) + 1)
   
8.     Loop Until d.exists(j) = False
   
9.     d(j) = i
   
10.     Range([A2], [A2].End(xlDown)).Cells(j).Offset(, 2) = i 'CÄæ±o¼ú
    
11.     Range([B2], [B2].End(xlDown)).Cells(i).Offset(, 2) = Range([A2], [A2].End(xlDown)).Cells(j)  'DÄæ±o¼ú
    
12. Next
    
13. End Sub

½Æ»s¥N½X

¤U¸ü (72.87 KB)

2014-1-20 16:57

GBKEE

¦^´_ 5# yeh6712
ÁÙ¦³¼gªk,¥i¬ã¨s.

1. Option Explicit
   
2. Sub Ex1()
   
3.     Dim i, J
   
4.     UsedRange.Offset(1, 2) = ""
   
5.     Do Until i + 1 = [B1].End(xlDown).Row                  '¼ú¶µ
   
6.         J = Int((([A1].End(xlDown).Row - 1) * Rnd) + 1)    '¶Ã¼Æ¤¶©ó 1 - ¤H­û¼Æ¶q ¤§¶¡
   
7.         If Range("C" & J + 1) = "" Then
   
8.             Range("C" & J + 1) = i + 1
   
9.             Range("D" & i + 2) = Range("A" & J + 1)
   
10.             i = i + 1
    
11.         End If
    
12.     Loop
    
13. End Sub

½Æ»s¥N½X

yeh6712

§Ú¦³¥t¤@­Ó·Qªk¡G­Y¤H­û¦³10¤H¡A¼ú¶µ¦³15­Ó¡F¨º´N¤H¤H¦³¼ú¡A¦ý¥u©â¥X10­Ó¡A

©Ò¥H©â¤¤ªº¤£¨£±o´N¬O1¡ã10¸¹ªº¼ú¶µ¡A¦p¦ó§ï¼g©O¡H

¦pªG¥Î¤W­±¤j¤jªº¼gªk¡A¤@©w·|¥u©â¤¤1¡ã10¸¹¡A¤S©Î¬O°j°é¶]¤£§¹¡K

·PÁ°աK¡I

GBKEE

¦^´_ 8# yeh6712

1. Option Explicit
   
2. Sub Ex1()
   
3.     Dim i As Integer, J As Integer, A As Integer, AJ(), AA()
   
4.     UsedRange.Offset(1, 2) = ""
   
5.     ReDim AJ(1 To [B1].End(xlDown).Row - 1)
   
6.     ReDim AA(1 To [A1].End(xlDown).Row - 1)
   
7.     '**** ¤H¤H¦³¼ú(¤@¶µ)
   
8.     Do Until i + 1 = [A1].End(xlDown).Row                  '¤H­û
   
9.         J = Int((([B1].End(xlDown).Row - 1) * Rnd) + 1)    '¶Ã¼Æ¤¶©ó 1 - ¼ú¶µ¼Æ¶q ¤§¶¡
   
10.         If AJ(J) = "" Then
    
11.             A = Int((([A1].End(xlDown).Row - 1) * Rnd) + 1)    '¶Ã¼Æ¤¶©ó 1 - ¤H­û¼Æ¶q ¤§¶¡
    
12.             If AA(A) = "" Then
    
13.                 AJ(J) = J
    
14.                 AA(A) = J
    
15.                 Range("C" & J + 1) = Range("A" & A + 1)        '¼ú«~±o¼ú¤H­û
    
16.                 i = i + 1
    
17.             End If
    
18.         End If
    
19.     Loop
    
20.     '**** ©â¥X³Ñ¾lªº¼ú¶µ
    
21.     For J = 1 To UBound(AJ)
    
22.         If AJ(J) = "" Then     '¥¼©â¥Xªº¼ú¶µ
    
23.             Do
    
24.                 A = Int((([A1].End(xlDown).Row - 1) * Rnd) + 1)    '¶Ã¼Æ¤¶©ó 1 - ¤H­û¼Æ¶q ¤§¶¡
    
25.                 If InStr(AA(A), ",") = 0 Then         'InStr(AA(A), ",") = 0;±Æ°£±o2­Ó¥H¤W¼ú¶µ
    
26.                     AA(A) = AA(A) & "," & J
    
27.                     Range("C" & J + 1) = Range("A" & A + 1)
    
28.                     Exit Do
    
29.                 End If
    
30.             Loop
    
31.         End If
    
32.     Next
    
33.     [D2].Resize(UBound(AA)) = Application.WorksheetFunction.Transpose(AA)  '¤H­ûªº±o¼ú¼ú«~
    
34. End Sub

½Æ»s¥N½X

yeh6712

¦^´_ 9# GBKEE

¤j¤j§Ú°õ¦æ«á¡A¥u·|¦³A©â¨ì¥B¬O1¸¹¡A¨ä¾l³£¬OªÅ¥Õ­C¡K