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

[µo°Ý] [¤w¸Ñ¨M]¦p¦ó¦a§}¤ÀÃþ

[µo°Ý] [¤w¸Ñ¨M]¦p¦ó¦a§}¤ÀÃþ

¥»©«³Ì«á¥Ñ owen9399 ©ó 2012-2-9 15:49 ½s¿è



¦p¦ó¼g ¨ç¼Æ ©Î vba

¦Û°Ê¤ÀÃþ¸ê®Æ:
§â¸ê®Æ¶K¤W sheet1 ªºªí³æ  , ·s¼W«ö¶s (¦a§}¦Û°Ê¤ÀÃþ)
Àx¦s©ó sheet2ªºªí³æ

1.¨ä¤¤ ¸ê®Æ¤¤ªº ¹ü¤Æ¿¤¹ü¤Æ¥«¥Ð¤¤¨½¢±¢³¾F¹ü®õ¤Gµó¢±¢·¤§¢°¢°¸¹¡@
Åܦ¨ ·s¸ê®Æ   ¹ü¤Æ¥«¹ü®õ¤Gµó¢±¢·¤§¢°¢°¸¹

¥h°£   ¹ü¤Æ¿¤ ¥Ð¤¤¨½ 24¾F «O¯d  ¹ü¤Æ¥«
¦ý¬O   «O¯d   ¹ü¤Æ¿¤©M¬üÂí ...¹ü¤Æ¿¤³À´äÂí ....µ¥   ¥~¿¤¶mÂí

2.
¦Û°Ê±Æ¦C  QTYªº¼Æ­È  ¥Ñ  ¤j±Æ¨ì¤p  

3.¤À°Ï°ìÀx¦s ¸ê®Æ©ó sheet2 ªºªí
¹ü¤Æ¥«ªº ©ñ¤@°_

¹ü¤Æ¿¤ªâ¶é¶m+¹ü¤Æ¿¤©M¬üÂí+¹ü¤Æ¿¤½u¦è¶m  ©ñ¤@°_

¹ü¤Æ¿¤³À´äÂí©ñ¤@°_

¹ü¤Æ¿¤·Ë´òÂí©ñ¤@°_

¦U°Ï  ªÅ®æ¶ZÂ÷(¶¡¶Z)10¦C




ÁÂÁ¤j¤j


¥t¥~ sheet2ªºªí³æ
zipªº¼Æ¦r ´N¤£­nÅã¥Ü¥X¨Ó ¥i¥H¦Û°Ê§R°£



¦a§}½d¥»:

¹ü¤Æ¿¤·Ë´òÂí¤¤¤s¨½¢±¢¯¾F¤j·Ë¸ô¤@¬q¢¶¢¯¢²¸¹¡@¡@¡@¡@¡@¡@¡@¡@¡@
¹ü¤Æ¿¤ªâ¶é¶m¦`áY§ø¢³¾F¹ü«n¸ô¤@¬q¢·¢³¢´¸¹¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@
¹ü¤Æ¥«¦è¿³¨½´º©vµó¢µ¢µ«Ñ¢±¢°¸¹¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@
¹ü¤Æ¿¤³À´äÂí·¾áY¨½¢µ¾F·¾áY«Ñ¢±¢¯¢·¸¹¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@
¹ü¤Æ¿¤³À´äÂí·s®c¨½¢¶¾F¤å¶}¸ô¢µ«Ñ¢±¢°¸¹¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@
¹ü¤Æ¿¤³À´äÂí´ººÖ¨½¢¸¾F´ººÖ«Ñ¢°¢°¢°¸¹¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@
¹ü¤Æ¿¤·Ë´òÂí¤¤¤s¨½¢²¾F¤j·Ë¸ô¢°¬q¢³¢¸¢³¸¹¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@
¹ü¤Æ¿¤·Ë´òÂíªF·Ë¨½¢±¾F»È¿õ¸ô¢±¢²¢±«Ñ¢¶¢³§Ë¢²¸¹¡@¡@¡@¡@¡@¡@¡@
¹ü¤Æ¿¤·Ë´òÂí¤¤¤s¨½¢²¾F¤j·Ë¸ô¢°¬q¢³¢¸¢³¸¹¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@



¹ü¤Æ¥«¤¤¥¿¸ô¤G¬q¢¸¢³¸¹¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@
¹ü¤Æ¿¤½u¦è¶m³»²p§ø¢°¢°¾F³»²p¸ô¢°¢±¢²¸¹¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@
¹ü¤Æ¿¤ªâ¶é¶m¦`áY§ø¢°¢¯¾FºÑ¶é¸ô¤@¬q¢²¢´¢´«Ñ¢´¸¹¡@¡@¡@¡@¡@¡@¡@
¹ü¤Æ¿¤¹ü¤Æ¥«¤U

¦a§}¤ÀÃþ.rar (3.47 KB)

owen

§Ú¥Ø«e ¦³¥Î  ¦r¦ê ¨Ó¨ú¥N

¦ý¦³¤@¨Ç°ÝÃD
owen

TOP

¥»©«³Ì«á¥Ñ Hsieh ©ó 2012-2-7 01:23 ½s¿è

¦^´_ 2# owen9399
¥i»s§@¤@­Ó¤ÀÃþªí
¦A¥H¤ÀÃþªí¬°¼Ð·Ç¨Ó¤ÀÃþ¦p¹Ï
  1. Sub nn()
  2. Dim Ar(2), Ay()
  3. Set d = CreateObject("Scripting.Dictionary")
  4. With Sheets("Sheet1")
  5. Ar(0) = Array(.[A1].Value, .[B1].Value, .[C1].Value, .[D1].Value, .[E1].Value)
  6. For Each a In .Range("E2", .[E65536].End(xlUp))
  7. i = IIf(InStr(a, "¿¤") > 0, 4, 1)
  8.    mystr = Mid(a, i, 3)
  9.    Set B = .Columns("I:K").Find(mystr, lookat:=xlWhole)
  10.    If B Is Nothing Then
  11.       ky = 5
  12.    Else
  13.       ky = .Cells(B.Row, "H").Value
  14.    End If
  15.    If IsEmpty(d(ky)) Then
  16.       Ar(1) = Array(a.Offset(, -4).Value, a.Offset(, -3).Value, a.Offset(, -2).Value, a.Offset(, -1).Value, a.Value)
  17.       d(ky) = Ar
  18.       Else
  19.       Ay = d(ky)
  20.       s = UBound(Ay)
  21.       ReDim Preserve Ay(s + 1)
  22.       Ay(s) = Array(a.Offset(, -4).Value, a.Offset(, -3).Value, a.Offset(, -2).Value, a.Offset(, -1).Value, a.Value)
  23.       d(ky) = Ay
  24.       Erase Ay
  25.     End If
  26. Next
  27. End With
  28. With Sheets("Sheet2")
  29. .[A:F] = ""
  30. r = 1
  31. For Each ky In d.keys
  32.    For i = LBound(d(ky)) To UBound(d(ky))
  33.       .Cells(r, "A").Resize(, 5) = d(ky)(i)
  34.       r = r + 1
  35.    Next
  36. Next
  37. End With
  38. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¥»©«³Ì«á¥Ñ owen9399 ©ó 2012-2-7 12:53 ½s¿è

½Ð°Ý  ¶W¯Åª©¥D Hsieh ©Î ¦U¦ì¤j¤j
1.¥i¥H­×§ï   ¥H¦¹¶¶§Ç ±Æ¦C
H        I        J        K        L
¤À²Õ               ¶mÂí¥«°Ï
1           ¹ü¤Æ¥«       
2           ªá¾Â¶m        ¨q¤ô¶m        ®HÆQ¶m        ·Ë´òÂí
3           ³À´äÂí        ºÖ¿³¶m
4           ½u¦è¶m        ¦ù´ä¶m        ©M¬üÂí        ªâ¶é¶m
       
       
2.³]©w  ¨C­¶ªº¤j¤p  ©T©w    ¦C¦L½d³ò  ª©­±³]©w    ¤W.¤U.¥ª.¥k:  ¦U¬°1cm

3.³]©w ¤À­¶      ¦p ¤À²Õ1   ¬°¤@­¶
A_NO        A_NM        QTY        TEL            ADDR
32848        ù**¡@¡@265000        04-75***            ¹ü¤Æ¥«¦è¿³¨½´º©vµó**«Ñ¢±*¸¹¡@

¥t¥~  ½Ð°Ý  
§Ú¦³·s¼W ¹ü¤Æ¥« ªº  (¨Ò¦p:500 . ¹ü¤Æ¿¤ . ¹ü¤Æ¿¤¹ü¤Æ¥«¡@. 0001¨½ . 13¾F...µ¥ )  ¥Î¦r¦ê ªí¥Ü ¨ú¥N ©Î ¤£Åã¥Ü  ,¦ý¬O ¦³¨Ç°ÝÃD   ,
       ¦p:   500¹ü¤Æ¿¤¹ü¤Æ¥«©µ¥­¨½15¾F¤¤¤s¸ô1¬q509¸¹    «ö¤U ­×§ï«ö¶s
        Åã¥Ü       ¹ü¤Æ¥«1¤¤¤s¸ô1¬q509¸¹   (15¾Fªº  1 ¥¼³Q¨ú¥N  ¦¨¤£Åã¥Ü)  

¥t¥~ ªþ¤W     §¹¾ãªº²M³æªºµ²ªG  +  ¦p¦ó­×¥¿Àɪº¸ê®Æªí
¦a§}¤ÀÃþ´ú¸Õ²M³æª©.rar (27.51 KB)      

¦a§}¤ÀÃþ´ú¸Õ­×¥¿ª©.rar (27.16 KB)
ÁÂÁ¤j¤jªº«ü¾É   


¹ü¤Æ¥« ©ñ¤@°_

ªá¾Â¶m        ¨q¤ô¶m        ®HÆQ¶m        ·Ë´òÂí  ªº©ñ¤@°_   
¦ý¬O    ªÅ¤@®æ
¨Ò¦p:   
A_NO        A_NM        QTY        TEL            ADDR
32848        ù**¡@¡@265000        04-75***            ¹ü¤Æ¿¤ªá¾Â¶m´º©vµó**«Ñ¢±*¸¹¡@

A_NO        A_NM        QTY        TEL            ADDR
328        ªL**¡@¡@26000        04-75***            ¹ü¤Æ¿¤¨q¤ô¶m·Ë¤ßµó**«Ñ1¢±*¸¹
3268        ¤ý**¡@¡@20230        04-75***            ¹ü¤Æ¿¤¨q¤ô¶m·Ë¤ßµó10**¸¹



¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@
owen

TOP

¥»©«³Ì«á¥Ñ Hsieh ©ó 2012-2-7 15:29 ½s¿è

¦^´_ 4# owen9399
¶mÂí¥«°Ï°µ¤ÀÃþ¤£¬O¶Ü?
  1. Sub Ex()
  2. Dim Mystr$, Ar(2), Ay()
  3. Set d = CreateObject("Scripting.Dictionary")
  4. With Sheets("Sheet1")
  5. Ar(0) = Array(.[A1].Value, .[B1].Value, .[C1].Value, .[D1].Value, .[E1].Value)
  6. For Each a In .Range("E2", .[E65536].End(xlUp))
  7.   i = IIf(InStr(a, "¿¤") > 0, 4, 1) + IIf(Val(a) > 0, Len(CStr(Val(a))), 0) '§PÂ_¶mÂí¥«°Ïªº°_©l¦ì¸m
  8.   Mystr = Mid(a, i, 3) '¶mÂí¥«°Ï
  9.   If IsEmpty(d(Mystr)) Then
  10.      Ar(1) = Array(a.Offset(, -4).Value, a.Offset(, -3).Value, a.Offset(, -2).Value, a.Offset(, -1).Value, a.Value)
  11.      d(Mystr) = Ar '¥H¶mÂí¥«°Ï°µ¯Á¤Þ¥[¤J¤º®e
  12.      Else
  13.      Ay = d(Mystr)
  14.      s = UBound(Ay)
  15.      ReDim Preserve Ay(s + 1)
  16.      Ay(s) = Array(a.Offset(, -4).Value, a.Offset(, -3).Value, a.Offset(, -2).Value, a.Offset(, -1).Value, a.Value)
  17.      d(Mystr) = Ay '¥H¶mÂí¥«°Ï°µ¯Á¤Þ¥[¤J¤º®e
  18.   End If
  19. Next
  20. End With
  21. With Sheets("Sheet2")
  22. .PageSetup.PrintArea = "$A:$E" '¦C¦L½d³ò
  23. .ResetAllPageBreaks '­«³]¤À­¶½u
  24. .Cells = ""
  25. r = 1
  26. For Each ky In d.keys
  27.    For i = LBound(d(ky)) To UBound(d(ky))
  28.       .Cells(r, 1).Resize(, 5) = d(ky)(i) '¼g¤J
  29.       r = r + 1
  30.    Next
  31.    .HPageBreaks.Add .Cells(r, "A") '¼W¥[¤À­¶
  32. Next
  33. End With
  34. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 4# owen9399
¦r¦êªº´À´«
  1. Sub «ö¶s3_Click()
  2.     Range("E2:E65536").Replace What:="*¹ü¤Æ¥«*¾F", Replacement:="¹ü¤Æ¥«", LookAt:=xlPart
  3. End Sub
½Æ»s¥N½X

TOP

ÁÂÁ¦U¦ì¤j¤jªº Á¿¸Ñ»P¤À¨É
owen

TOP

¦^´_ 7# owen9399
¼Ó¥Dªº¸ê®Æ¨Ã¤£¥]§tª½ÁÒ¥«¦a§}®æ¦¡
¥H¤Uµ{¦¡½X¥i§PÂ_ª½ÁÒ¥«
¨Ã¨ú±o¶m¡BÂí¡B¥«¡B°Ïªº¦WºÙ°µ¤ÀÃþ
½Ð¦U¦ì·Q·Q¬O§_¦³§ó¦³®Ä²v¥B¾A¥Î©Ê§ó¼sªº¤è¦¡
  1. Sub ex()
  2. Dim Ay(2), Ary()
  3. Set d = CreateObject("Scripting.Dictionary")
  4. ar = Array("¶m", "Âí", "¥«", "°Ï")
  5. With Sheets("Sheet1")
  6. Ay(0) = Array(.[A1].Value, .[B1].Value, .[C1].Value, .[D1].Value, .[E1].Value)
  7. For Each a In .Range("E2", .[E65536].End(xlUp))
  8. For i = 0 To 3
  9.   If k < InStr(a, ar(i)) Then k = InStr(a, ar(i)): b = Mid(a, k, 1)
  10. Next
  11. '¨ú±o¶mÂí¥«°Ï¦r¦ê
  12. mystr = Mid(a, 1, k):   k = 0
  13. If InStr(mystr, "¿¤") > 0 Then mystr = Mid(mystr, InStr(mystr, "¿¤") + 1) '¥h°£¿¤¦W
  14. If InStr(mystr, "¥«") > 0 And InStr(mystr, "°Ï") > 0 Then mystr = Mid(mystr, InStr(mystr, "¥«") + 1) '¥h°£ª½ÁÒ¥«
  15. If Val(mystr) > 0 Then mystr = Mid(mystr, Len(CStr(Val(mystr))) + 1) '¥h°£¶l»¼°Ï¸¹

  16. If IsEmpty(d(mystr)) Then '¥H¥¼¥X²{¹Lªº¶mÂí¥«°Ï¦r¦ê§@¬°¯Á¤Þ¥[¤J¤º®e
  17.    Ay(1) = Array(a.Offset(, -4).Value, a.Offset(, -3).Value, a.Offset(, -2).Value, a.Offset(, -1).Value, a.Value)
  18.    d(mystr) = Ay
  19.    Else '¥H¥X²{¹Lªº¶mÂí¥«°Ï¦r¦ê§@¬°¯Á¤Þ¥[¤J¤º®e
  20.    Ary = d(mystr) '¨ú¥X°}¦C
  21.    s = UBound(Ary)
  22.    ReDim Preserve Ary(s + 1) 'ÂX¤j°}¦C
  23.    Ary(s) = Array(a.Offset(, -4).Value, a.Offset(, -3).Value, a.Offset(, -2).Value, a.Offset(, -1).Value, a.Value)
  24.    d(mystr) = Ary '¼g¦^¶mÂí¥«°Ï¦r¦ê§@¬°¯Á¤Þªº¤º®e
  25. End If
  26. Next
  27. End With
  28. With Sheets("Sheet2")
  29. .Cells = ""
  30. r = 1
  31. For Each ky In d.keys '¥H¶mÂí¥«°Ï¤ÀÃþªº°j°é
  32.   For i = LBound(d(mystr)) To UBound(d(ky))
  33.    .Cells(r, 1).Resize(, 5) = d(ky)(i) '¼g¤J
  34.    r = r + 1
  35.   Next
  36. Next
  37. End With
  38. End Sub
½Æ»s¥N½X
¦a§}¤ÀÃþ.rar (14.04 KB)
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¥»©«³Ì«á¥Ñ owen9399 ©ó 2012-2-9 10:42 ½s¿è

ÁÂÁ ¤j¤jªº´£¨Ñ  

·Q½Ð°Ý ¦p¦ó©T©w   A1~E1ªºÄæ¼e
¨Ò¦p:    A1Äæ¼e¬°8  , B1Äæ¼e¬°9  ,C1Äæ¼e¬°10  ,  D1Äæ¼e¬°10    ,E1 Äæ¼e¬° 50

´Nºâ ±q§OªºB¸ê®Æ ½Æ»s  ,¶K¤W ¨äÄæ¦ì¤]«O«ù¤£ÅÜ
owen

TOP

¦^´_ 9# owen9399

¿ïAÄæ¦ì¼ÐÅÒ, ®æ¦¡/Äæ/Äæ¼e ,¿é¤J8
....   

Äæ¼e¥»¨Ó´N¬O©T©wªº,°£«D¦Û¤v¥h§ïÅÜ¥¦,©Ò¥HÀ³¤£»Ý­n¥ÎVBA¥h³]©wÄæ¼e

VBA»yªk
Columns("A:A").ColumnWidth =8

TOP

        ÀR«ä¦Û¦b : ¥Í®ð¡A´N¬O®³§O¤Hªº¹L¿ù¨ÓÃg»@¦Û¤v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD