- ©«¤l
- 4901
- ¥DÃD
- 44
- ºëµØ
- 24
- ¿n¤À
- 4916
- ÂI¦W
- 248
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Office 20xx
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥x¥_
- µù¥U®É¶¡
- 2010-4-30
- ³Ì«áµn¿ý
- 2024-11-16
|
¦^´_ 22# white5168
§â¾ãÅé¬yµ{·§©Àµù¸Ñ«á¡A¬Ý¬Ý»P§Aªº·Qªk¸¨®t¦bþ?- Sub Get_Data()
- Dim Ar(), Ay(), x, Mystr$, A
- Set d = CreateObject("Scripting.Dictionary")
- Set d1 = CreateObject("Scripting.Dictionary")
- Set d2 = CreateObject("Scripting.Dictionary")
- ChDir ThisWorkbook.Path
- fs = Application.GetOpenFilename("³rÂI¤À¹j (CSV) (*.csv), *.csv") '¶}±Ò¸ê®ÆÀÉ®×¹ï¸Ü¤è¶ô¿ï¾ÜCSVÀÉ®×
- Open fs For Input As #1 'Ū¨úCSVÀÉ®×
- Do Until EOF(1)
- Line Input #1, Mystr 'Ū¨ú¤@¦æ¸ê®Æ¼g¤JÅܼÆ
- A = Split(Mystr, ",") '±N¸ê®Æ¤Á³Î¦s¤J°}¦C
- If Val(A(0)) > 0 And Val(A(0)) <= [B1] Then '§PÂ_¬O§_¦bµ²ºâ¤é´Á¤§«eªº¸ê®Æ
- If IsEmpty(d(A(1))) Then '¥H²£«~½s¸¹¬°¯Á¤ÞY¤£¦s¦b
- For i = 1 To Val(A(3)) '¥H¶R¤J¼Æ¶q°µ°j°é¡B°O¾Ð¦í¨C¤@Óªº³æ»ù
- ReDim Preserve Ar(i)
- Ar(i - 1) = Val(A(2))
- Next
- If Val(A(3)) > 0 Then d(A(1)) = Ar '¦pªG¦³¼Æ¶q´N±N°}¦C¦s¨ì¦r¨å¤¤
- Else '¤]´N¬O¦³²Ä¤Gµ§¥H¤W¶R¤J®É°õ¦æ
- Ar = d(A(1)) '¥ý¨ú¥X¸Ó½s¸¹¤w¸gÁʶRªº¸ê®Æ¦s¤J°}¦C
- s = UBound(Ar)
- For i = 1 To Val(A(3)) '±N¨Cµ§¸ê®Æ³æ»ù¥[¤J¦¹°}¦C
- ReDim Preserve Ar(s + i)
- Ar(s + i - 1) = Val(A(2))
- Next
- s = UBound(Ar)
- d(A(1)) = Ar '±N°}¦C¦^¦s¨ì¦r¨åª«¥ó
- End If
- If Val(A(4)) > 0 Then '½æ¥X¸ê°T³B²z¡A»P¶R¤JÆ[©À¬Û¦P
- If IsEmpty(d1(A(1))) Then
- For i = 1 To Val(A(4))
- ReDim Preserve Ar(i)
- Ar(i - 1) = Val(A(2))
- Next
- If Val(A(4)) > 0 Then d1(A(1)) = Ar
- Else
- Ar = d1(A(1))
- s = UBound(Ar)
- For i = 1 To Val(A(4))
- ReDim Preserve Ar(s + i)
- Ar(s + i - 1) = Val(A(2))
- Next
- d1(A(1)) = Ar
- End If
- End If
- End If
- Erase Ay: Erase Ar '³B²z¤U¤@µ§¸ê®Æ«e¥ý§âì¨Óªº¶R½æ°O¾Ð®ø°£
- Loop
- Close #1 'Ãö³¬CSVÀÉ®×
- For Each ky In d1.keys
- If IsArray(d1(ky)) Then Ar = d1(ky): x = UBound(Ar) Else x = 0 '¥X³f¸ê®ÆY¬O°}¦C´N¨ú¥X°}¦C¥i±oª¾¨ì©³¦³´Xµ§¥X³f¸ê°T
- If IsArray(d(ky)) Then Ay = d(ky): y = UBound(Ay) Else y = 0 '¶i³f¸ê®ÆY¬O°}¦C´N¨ú¥X°}¦C¥i±oª¾¨ì©³¦³´Xµ§¶i³f¸ê°T
- '¥H¤U´N¤£¦Pª¬ªppºâ¦UÄæ¦ìÀ³¦³ªºÈ¼g¤J°}¦C
- If x = 0 And y > 0 Then '¥u¶i¤£¥X
- bp = Application.Average(Ay) '¶i³f¥§¡»ù
- d2(ky) = Array(ky, y, 0, 0, Abs(y - x), y - x, Round(bp, 2), 0)
- bp = 0
- ElseIf y = 0 And x > 0 Then '¥u¥X¤£¶i
- sp = Application.Average(Ar) '¥X³f¥§¡»ù
- d2(ky) = Array(ky, y, x, 0, 0, y - x, 0, Round(sp, 2))
- sp = 0
- ElseIf x > 0 And y > 0 Then
- If x > y Then '¥X¤j©ó¶i
- w = 0: w1 = y - x
- For i = 0 To y - 1
- pr = pr + Ar(i) - Ay(i) 'pºâ¥X³f»P¶i³fªº»ù®t²Öp¡B³o¬O¯u¥¿Àò§QÈ¥i¯à»P´£°ÝªÌªºÆ[©À®t²§
- Next
- For j = i To x - 1 '¤£°÷¦©pºâ
- nr = nr + Ar(i)
- Next
- nr = nr / (x - y) '¤£¨¬¶q
- ElseIf x < y Then '¶i¤j©ó¥X
- w1 = 0: w = y - x
- For i = 0 To x - 1
- pr = pr + Ar(i) - Ay(i) 'pºâ¥X³f»P¶i³fªº»ù®t²Öp¡B³o¬O¯u¥¿Àò§QÈ¥i¯à»P´£°ÝªÌªºÆ[©À®t²§
- Next
- For j = i To y - 1 '³Ñ¾l¶qpºâ
- sr = sr + Ay(i)
- Next
- sr = sr / Abs(x - y) '¤£¨¬¶q
- End If
- d2(ky) = Array(ky, y, x, pr, w, w1, Round(sr, 2), Round(nr, 2)) '¼g¤J°}¦C
- pr = 0: nr = 0: sr = 0
- End If
- Erase Ay: Erase Ar
- Next
- [A4:H65536] = ""
- [A4].Resize(d2.Count, 8) = Application.Transpose(Application.Transpose(d2.items))
- End Sub
½Æ»s¥N½X |
|