- ©«¤l
- 4901
- ¥DÃD
- 44
- ºëµØ
- 24
- ¿n¤À
- 4916
- ÂI¦W
- 278
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Office 20xx
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥x¥_
- µù¥U®É¶¡
- 2010-4-30
- ³Ì«áµn¿ý
- 2024-12-25
|
¦^´_ 7# owen9399
¼Ó¥Dªº¸ê®Æ¨Ã¤£¥]§tª½ÁÒ¥«¦a§}®æ¦¡
¥H¤Uµ{¦¡½X¥i§PÂ_ª½ÁÒ¥«
¨Ã¨ú±o¶m¡BÂí¡B¥«¡B°Ïªº¦WºÙ°µ¤ÀÃþ
½Ð¦U¦ì·Q·Q¬O§_¦³§ó¦³®Ä²v¥B¾A¥Î©Ê§ó¼sªº¤è¦¡- Sub ex()
- Dim Ay(2), Ary()
- Set d = CreateObject("Scripting.Dictionary")
- ar = Array("¶m", "Âí", "¥«", "°Ï")
- With Sheets("Sheet1")
- Ay(0) = Array(.[A1].Value, .[B1].Value, .[C1].Value, .[D1].Value, .[E1].Value)
- For Each a In .Range("E2", .[E65536].End(xlUp))
- For i = 0 To 3
- If k < InStr(a, ar(i)) Then k = InStr(a, ar(i)): b = Mid(a, k, 1)
- Next
- '¨ú±o¶mÂí¥«°Ï¦r¦ê
- mystr = Mid(a, 1, k): k = 0
- If InStr(mystr, "¿¤") > 0 Then mystr = Mid(mystr, InStr(mystr, "¿¤") + 1) '¥h°£¿¤¦W
- If InStr(mystr, "¥«") > 0 And InStr(mystr, "°Ï") > 0 Then mystr = Mid(mystr, InStr(mystr, "¥«") + 1) '¥h°£ª½ÁÒ¥«
- If Val(mystr) > 0 Then mystr = Mid(mystr, Len(CStr(Val(mystr))) + 1) '¥h°£¶l»¼°Ï¸¹
- If IsEmpty(d(mystr)) Then '¥H¥¼¥X²{¹Lªº¶mÂí¥«°Ï¦r¦ê§@¬°¯Á¤Þ¥[¤J¤º®e
- Ay(1) = Array(a.Offset(, -4).Value, a.Offset(, -3).Value, a.Offset(, -2).Value, a.Offset(, -1).Value, a.Value)
- d(mystr) = Ay
- Else '¥H¥X²{¹Lªº¶mÂí¥«°Ï¦r¦ê§@¬°¯Á¤Þ¥[¤J¤º®e
- Ary = d(mystr) '¨ú¥X°}¦C
- s = UBound(Ary)
- ReDim Preserve Ary(s + 1) 'ÂX¤j°}¦C
- Ary(s) = Array(a.Offset(, -4).Value, a.Offset(, -3).Value, a.Offset(, -2).Value, a.Offset(, -1).Value, a.Value)
- d(mystr) = Ary '¼g¦^¶mÂí¥«°Ï¦r¦ê§@¬°¯Á¤Þªº¤º®e
- End If
- Next
- End With
- With Sheets("Sheet2")
- .Cells = ""
- r = 1
- For Each ky In d.keys '¥H¶mÂí¥«°Ï¤ÀÃþªº°j°é
- For i = LBound(d(mystr)) To UBound(d(ky))
- .Cells(r, 1).Resize(, 5) = d(ky)(i) '¼g¤J
- r = r + 1
- Next
- Next
- End With
- End Sub
½Æ»s¥N½X
¦a§}¤ÀÃþ.rar (14.04 KB)
|
|