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

[µo°Ý] ½Ð°Ý¦p¦ó¥Îexcel VBA¼g¤@­Ó¥H¥ý¶i¥ý¥Xªº¤è¦¡¨Ó¨ú±o²£«~ªº¼Æ¶q»P¥­§¡»ù®æ

¦^´_ 20# white5168
§Ú¨Ã«D¬ì¯Z¥X¨­¡A¥uÀ´¤@ÂIVBA¥Ö¤ò¡A¨ä¥Lµ{¦¡¤£À´
¦Ü©ó±z©Ò¿×¼Ò²Õ¤Æ¡A§Ú¨Ã¤£¤F¸Ñ¨ä¸q
¦pªG±z½T©w¶K¹Ï¸ê®Æ¬O¥¿½T¡A¨º§Úªºµ{¦¡½X¶]¥X¨Óµ²ªG´N¥²µM¬O¿ùªº
¥²¶·¦A¨Ó¬Ý¬Ý­þÃä¥X°ÝÃD¤F
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¥»©«³Ì«á¥Ñ white5168 ©ó 2012-5-1 17:58 ½s¿è

ÁÂÁÂHsieh¤j¤jªº¦^ÂÐ
§Ú·Q¥u¯à¥ý¸Õ¸Õ¬Ý±z©Ò¶Kªºµ{¦¡½X,¦Ü©óªþ¥óªº³¡¥÷µ¥¤É¯Å«á¦A¤U¸ü,¥ý¸Õ¸Õ¬Ý¬ÛÃöªº³¡¤À¬O§_¥i¦æ

¨ä¹ê­ì©l¸ê®Æ¤¤ÁÙ¦³¥]§t±q¤µ¦~¦~ªì¨ì²{¦bªº¥æ©ö¤é´Á,¼t°Ó,¦Ó¨C®a¼t°Óªº°Ó«~¤S¤£¬Û¦P, ¤S©È¤j®a¬Ý¤F·|§óÀY©ü,©Ò¥H§Ú¥Ø«e¥u¦C°Ó«~ªº¶R½æ©ú²Ó
µ¥§Ú¥ý¬Ý¤j¤j¼gªº§¹«á¦A¸ò±z½Ð¯q·í¥[¤J¼t°Ó«áªº¸ê°T,§Ú¥i¥H¥ý¹w§i¼t°Ó¦³1090¦h®a,¦Ó¨C®a½æªº°Ó«~¥[¥[´î´îªºÁ`¦@¦³1400¦h¼Ë,¦Ó³o¨âÃ䪺¸ê®Æ¶qÁÙ¦b¼W¥[·í¤¤,¬Û«H³o¼ËªºÃø«×¤S§ó°ª
§Æ±æ¯à±q¤j¤jªº¸gÅ礤§l¨ú³B²z³o¼ËÃe¤j¸ê®Æªº¤èªk

TOP

¥»©«³Ì«á¥Ñ wang ©ó 2012-5-2 21:20 ½s¿è

¹ï¤£°_  ·|¿ù·N  ¦Û§R

TOP

¥»©«³Ì«á¥Ñ white5168 ©ó 2012-5-2 00:22 ½s¿è

bbojj¤j¤j
ªº½T¬O¨C¤é¦UªÑ¦b¥þ¥x©Ò¦³劵°Óªº¦¨¥æ©ú²Ó,§Ú¬O¥Îpython§ì¤U¨Ó(¥ÎExcel VBA§ì¸ê®Æ·|«ÜºC,¦Ó¥B·|·í,¦]¬°¨C¤Ñªº¸ê®Æ¶q´N¬ù70MB~90MB),¦p¦A¥[¤W­n¤ÀªR³o¨Ç¸ê®ÆÅK©w§óºG
¦]¦¹¥Hpython§ì¸ê®Æ(°ê¥~¤w¦³±Npython©w¦ì¬°ª÷¿Äªºµ{¦¡»y¨¥),MySQL©ÎAccess¦s¸ê®Æ,Excel VBA¨Ó§@¸ê®Æ¤ÀªR¤~·|¬O¤£¿ùªº¬[ºc¿ï¾Ü,¥u¥i±¤¥Ø«e³o¸Ì¨Ã¨S¦³¹J¨ì·|¨Ï¥Îpythonªº¤H,¦³¿³½ì¥i¥H¬Û¤¬°Q½×,¤]«ØijªO¥D¯à¶}¤@­Ópythonªº°Q½×ª©
Â÷ÃD¤F,¯u©êºp,§ÚÁÙ¬O¥ý¨Ä¨Ä¾Ç¦nExcel VBA

TOP

¦^´_ 25# white5168

¥ý«e¦b¥t¤@©«¸Ì(»P¥»©«¤º®e¬Û¦P,­«Âеo©«¤F)¤w§@¦^ÂÐ
Hsieh¶Wª©¦b¥»©«¸Ì¥ç§@¤F¦^ÂÐ

ªþ¤WHª©»PRª©µ{¦¡°õ¦æµ²ªG¤§¤ñ¸û¨Ñ°Ñ¦Ò,¦³¤£¹ïªº¦a¤è¦A§@¦^ÂÐ
¶À¦âºô©³§Y¬°2­Óª©¥»¤£¦P¤§³B

³Ì«á¸ê®Æ Rª©vsHª©.rar (8.32 KB)

TOP

¦^´_ 22# white5168
§â¾ãÅé¬yµ{·§©Àµù¸Ñ«á¡A¬Ý¬Ý»P§Aªº·Qªk¸¨®t¦b­þ?
  1. Sub Get_Data()
  2. Dim Ar(), Ay(), x, Mystr$, A
  3. Set d = CreateObject("Scripting.Dictionary")
  4. Set d1 = CreateObject("Scripting.Dictionary")
  5. Set d2 = CreateObject("Scripting.Dictionary")
  6. ChDir ThisWorkbook.Path
  7. fs = Application.GetOpenFilename("³rÂI¤À¹j (CSV) (*.csv), *.csv") '¶}±Ò¸ê®ÆÀÉ®×¹ï¸Ü¤è¶ô¿ï¾ÜCSVÀÉ®×

  8. Open fs For Input As #1 'Ū¨úCSVÀÉ®×
  9. Do Until EOF(1)
  10.    Line Input #1, Mystr 'Ū¨ú¤@¦æ¸ê®Æ¼g¤JÅܼÆ
  11.    A = Split(Mystr, ",") '±N¸ê®Æ¤Á³Î¦s¤J°}¦C
  12.    If Val(A(0)) > 0 And Val(A(0)) <= [B1] Then '§PÂ_¬O§_¦bµ²ºâ¤é´Á¤§«eªº¸ê®Æ
  13.    If IsEmpty(d(A(1))) Then '¥H²£«~½s¸¹¬°¯Á¤Þ­Y¤£¦s¦b
  14.        For i = 1 To Val(A(3)) '¥H¶R¤J¼Æ¶q°µ°j°é¡B°O¾Ð¦í¨C¤@­Óªº³æ»ù
  15.           ReDim Preserve Ar(i)
  16.           Ar(i - 1) = Val(A(2))
  17.        Next
  18.        If Val(A(3)) > 0 Then d(A(1)) = Ar '¦pªG¦³¼Æ¶q´N±N°}¦C¦s¨ì¦r¨å¤¤
  19.        Else '¤]´N¬O¦³²Ä¤Gµ§¥H¤W¶R¤J®É°õ¦æ
  20.        Ar = d(A(1)) '¥ý¨ú¥X¸Ó½s¸¹¤w¸gÁʶRªº¸ê®Æ¦s¤J°}¦C
  21.        s = UBound(Ar)
  22.          For i = 1 To Val(A(3)) '±N¨Cµ§¸ê®Æ³æ»ù¥[¤J¦¹°}¦C
  23.            ReDim Preserve Ar(s + i)
  24.            Ar(s + i - 1) = Val(A(2))
  25.          Next
  26.        s = UBound(Ar)
  27.          d(A(1)) = Ar '±N°}¦C¦^¦s¨ì¦r¨åª«¥ó
  28.     End If
  29.     If Val(A(4)) > 0 Then '½æ¥X¸ê°T³B²z¡A»P¶R¤JÆ[©À¬Û¦P
  30.        If IsEmpty(d1(A(1))) Then
  31.        For i = 1 To Val(A(4))
  32.           ReDim Preserve Ar(i)
  33.           Ar(i - 1) = Val(A(2))
  34.        Next
  35.        If Val(A(4)) > 0 Then d1(A(1)) = Ar
  36.        Else
  37.        Ar = d1(A(1))
  38.        s = UBound(Ar)
  39.          For i = 1 To Val(A(4))
  40.            ReDim Preserve Ar(s + i)
  41.            Ar(s + i - 1) = Val(A(2))
  42.          Next
  43.          d1(A(1)) = Ar
  44.     End If
  45.     End If
  46.     End If
  47.    Erase Ay: Erase Ar '³B²z¤U¤@µ§¸ê®Æ«e¥ý§â­ì¨Óªº¶R½æ°O¾Ð®ø°£
  48. Loop
  49. Close #1 'Ãö³¬CSVÀÉ®×
  50. For Each ky In d1.keys
  51.    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
  52.    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
  53.    '¥H¤U´N¤£¦Pª¬ªp­pºâ¦UÄæ¦ìÀ³¦³ªº­È¼g¤J°}¦C
  54.    If x = 0 And y > 0 Then '¥u¶i¤£¥X
  55.         bp = Application.Average(Ay) '¶i³f¥­§¡»ù
  56.       d2(ky) = Array(ky, y, 0, 0, Abs(y - x), y - x, Round(bp, 2), 0)
  57.       bp = 0
  58.       ElseIf y = 0 And x > 0 Then '¥u¥X¤£¶i
  59.       sp = Application.Average(Ar) '¥X³f¥­§¡»ù
  60.       d2(ky) = Array(ky, y, x, 0, 0, y - x, 0, Round(sp, 2))
  61.       sp = 0
  62.       ElseIf x > 0 And y > 0 Then
  63.          If x > y Then '¥X¤j©ó¶i
  64.          w = 0: w1 = y - x
  65.          For i = 0 To y - 1
  66.          pr = pr + Ar(i) - Ay(i) '­pºâ¥X³f»P¶i³fªº»ù®t²Ö­p¡B³o¬O¯u¥¿Àò§Q­È¥i¯à»P´£°ÝªÌªºÆ[©À®t²§
  67.          Next
  68.          For j = i To x - 1 '¤£°÷¦©­pºâ
  69.          nr = nr + Ar(i)
  70.          Next
  71.          nr = nr / (x - y) '¤£¨¬¶q
  72.          ElseIf x < y Then '¶i¤j©ó¥X
  73.          w1 = 0: w = y - x
  74.          For i = 0 To x - 1
  75.          pr = pr + Ar(i) - Ay(i) '­pºâ¥X³f»P¶i³fªº»ù®t²Ö­p¡B³o¬O¯u¥¿Àò§Q­È¥i¯à»P´£°ÝªÌªºÆ[©À®t²§
  76.          Next
  77.          For j = i To y - 1 '³Ñ¾l¶q­pºâ
  78.          sr = sr + Ay(i)
  79.          Next
  80.          sr = sr / Abs(x - y) '¤£¨¬¶q
  81.          End If
  82.          d2(ky) = Array(ky, y, x, pr, w, w1, Round(sr, 2), Round(nr, 2)) '¼g¤J°}¦C
  83.          pr = 0: nr = 0: sr = 0
  84.    End If
  85.    Erase Ay: Erase Ar
  86. Next
  87. [A4:H65536] = ""
  88. [A4].Resize(d2.Count, 8) = Application.Transpose(Application.Transpose(d2.items))
  89. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

        ÀR«ä¦Û¦b : ¬O«D·í±Ð¨|¡AÆg¬ü§@ĵ±§¡C
ªð¦^¦Cªí ¤W¤@¥DÃD