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

[µo°Ý] ¸ê®Æ¾ã²z»P²Î­p

[µo°Ý] ¸ê®Æ¾ã²z»P²Î­p

¦pªþ¥ó
ºñ¦â¼ÐÅÒ¬¡­¶¬O§Ú¤@¥b§Q¥Î¨ç¼Æ¤@¥b¥Î¤H¤u©Ò°µ¦¨
­Y­n§Q¥ÎVB°µ¦¨¼ÐÅÒ¦WºÙ¬°"¤Àµ§¶q"¬¡­¶
­n¦p¦ó¤~¯à¹F¦¨

1216-060217-¤é¤Àµ§¶q.rar (67.18 KB)

½Ð´ú¸Õ
  1. Option Base 1

  2. Sub test()
  3.     Dim d As Object
  4.     Dim arr, brr()
  5.     Set d = CreateObject("Scripting.Dictionary")
  6.     s = Array(1000, 5000, 10000, 15000, 20000, 30000, 40000, 50000, 100000, 200000, 400000, 600000, 800000, 1000000, 2000000, 3000000)
  7.     er = [A65536].End(3).Row
  8.     arr = Range("A8:C" & er)
  9.     Range("A8:C" & er).Sort key1:=[A8], Order1:=2
  10.     For i = 1 To UBound(arr)
  11.         If Not d.exists(arr(i, 1)) Then
  12.             n = n + 1
  13.             d(arr(i, 1)) = n
  14.         End If
  15.     Next i
  16.     ReDim brr(d.Count, UBound(s) * 4)
  17.     [D8:D65536].ClearContents
  18.     [D8].Resize(d.Count) = Application.Transpose(d.keys)
  19.     Range("A8:C" & er) = arr
  20.     For i = 1 To UBound(arr)
  21.         For j = 2 To 3
  22.             If arr(i, j) >= 1000 Then
  23.                 For a = 1 To UBound(s) - 1
  24.                     If arr(i, j) >= s(a) And arr(i, j) < s(a + 1) Then
  25.                         brr(d(arr(i, 1)), (a - 1) * 4 + j * 2 - 3) = brr(d(arr(i, 1)), (a - 1) * 4 + j * 2 - 3) + arr(i, j)
  26.                         brr(d(arr(i, 1)), (a - 1) * 4 + j * 2 - 2) = brr(d(arr(i, 1)), (a - 1) * 4 + j * 2 - 2) + 1
  27.                         Exit For
  28.                     End If
  29.                 Next a
  30.             End If
  31.         Next j
  32.     Next i
  33.     [E8].Resize(UBound(brr), UBound(brr, 2)) = brr
  34.     arr = ""
  35.     Set d = Nothing
  36.     Erase brr
  37. End Sub
½Æ»s¥N½X

TOP

ÁÂÁÂkubi¤j¤j§A¼ö¤ßÀ°§Ú³o­Ó¦£
¥u¬O¸g§Ú´ú¸Õ¦ü¥G(±Nµ{¦¡½X¥H«öÁäÁÍ°Ê)
°£¤F¼Æ¾ÚÅã¥Ü¦ì¸m¦³»~¥~
¨Ì½s¸¹¦U¯Å¶Z©Ò¦X­p»Pµ§¼Æ¦ü¥G»P§Ú¦Û¤v°µªº¨ç¼Æ+¤â°Êªº¼Æ»E¦³©Ò®t¶Z

060222-¤é¤Àµ§¶q - test.rar (112.03 KB)

TOP

¦^´_ 3# oak0723-1

§Aªºµ{¦¡½X©ñ¿ù¼Ò²Õ¡A¤£À³¸Ó©ñ¦b¤u§@ªí¼Ò²Õ¡AÀ³¸Ó©ñ¦b¤@¯ë¼Ò²Õ¤º¡A½Ð°Ñ¦Òªþ¥[ÀɮסC
½Ð°õ¦æ [¸ê®Æ¤Àµ§] «ö¶s¡C
060222-¤é¤Àµ§¶q - test1.rar (119.12 KB)

TOP

ÁÂÁÂ
¤p§Ì¦n¦n¬ã¨s¤@¤U

TOP

ÁÂÁÂkubi¤j¤j
¤p§Ì­è­è´«¤@²Õ¼Æ¾Ú´ú¸Õ
µo²{½s¸¹±Æ§Ç¨Ã«D¥Ñ¤W¦Ó¤U»¼´î±Æ¦C
¦p¦ó­×¥¿¬°¥Ñ¤W¨ì¤U»¼´î±Æ¦C

060223-¤é¤Àµ§¶q - test2.rar (124.1 KB)

TOP

¦^´_ 6# oak0723-1
½Ð´ú¸Õ¡C
060223-¤é¤Àµ§¶q - test3.rar (130.13 KB)

TOP

  1. Sub test_1()
  2. Dim xD As Object, Arr, Brr, V, N&, U%, i&, j%, k%, Km%
  3. Set xD = CreateObject("Scripting.Dictionary")
  4. s = Array(1, 5, 10, 15, 20, 30, 40, 50, 100, 200, 400, 600, 800, 1000, 2000, 3000, 60000)
  5. Arr = Range("A8:C" & [A65536].End(3).Row)

  6. ReDim Brr(1 To UBound(Arr), 1 To UBound(s) * 4 + 1)
  7. del
  8. For i = 1 To UBound(Arr)
  9.     V = Arr(i, 1): U = xD(V)
  10.     If U = 0 Then N = N + 1: U = N: xD(V) = N: Brr(U, 1) = V
  11.     For j = 2 To 3
  12.         Km = 0
  13.         For k = 0 To UBound(s)
  14.             If s(k) * 1000 > Arr(i, j) Then Km = (k - 1) * 4: Exit For
  15.         Next k
  16.         If Km >= 0 Then
  17.            Brr(U, Km + j * 2 - 2) = Brr(U, Km + j * 2 - 2) + Arr(i, j)
  18.            Brr(U, Km + j * 2 - 1) = Brr(U, Km + j * 2 - 1) + 1
  19.         End If
  20.     Next j
  21. Next i
  22. With [D8].Resize(N, UBound(s) * 4 + 1)
  23.      .Value = Brr
  24.      .Sort Key1:=.Item(1), Order1:=xlDescending, Header:=xlNo
  25. End With
  26. End Sub
½Æ»s¥N½X

TOP

¸g¤p§Ì´ú¸Õ«á½T¹ê¬°¥¿¸Ñ
ÁÂÁÂkubi»P­ã´£³¡ªL¤j¤j¼ö¤ß¸Ñµª
Åý¤p§ÌÀò±o¸Ñµª
ÁÂÁÂ
«D±`·P®¦
³Ò¤O!!!

TOP

½Ð°Ý­Y·Q¦b¤w¼Ð¥Ü¶À©³¬õ¦r¤§Àx¦s®æ¤º¿é¤J¥ô·N¸ê®Æ°µ¤ÀÃþ,À³¦p¦ó°µ§ó§ï(¦pªþ¥ó)

060315-¤é¤Àµ§¶q - test1.rar (125.22 KB)

TOP

        ÀR«ä¦Û¦b : ¡i¬°µ½Ävª§¡j¤H¥Í­n¬°µ½Ävª§¡A¤À¬í¥²ª§¡C
ªð¦^¦Cªí ¤W¤@¥DÃD