- ©«¤l
- 406
- ¥DÃD
- 8
- ºëµØ
- 0
- ¿n¤À
- 453
- ÂI¦W
- 0
- §@·~¨t²Î
- WINDOWS 7
- ³nÅ骩¥»
- 2007
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2015-2-7
- ³Ì«áµn¿ý
- 2021-7-31
|
¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-8-22 03:21 ½s¿è
¦^´_ 18# qaqa3296
½T©w´N³o4ºØ®æ¦¡ºO? ´N¥Î§A³o4ºØ®æ¦¡¶i¦æ¼Ò½k¤ñ¹ï~
¦pªGn²K¥[¨ä¥L®æ¦¡¦b»¡ ¡A§Ú·Q§A¬Ý¤F§Úªºµ{¦¡¤]¥i¥H¦Û¤v§ï¤F
³o¸Ì«Ü¦h¤H³£¥i¥HÀ°§A§¹¦¨¡A¥un§AÅÞ¿è±Ôz°÷²M·¡!
²³æªºªF¦è¨S¥²n·d½ÆÂø¡A§Úªºµ{¦¡ÅÞ¿è¦p¤U
1.¨Ì4ºØ®æ¦¡ªº³W®æÄæ¦ì¥h¬d¸ß®w¦s¡A¶i¦æ¼Ò½k¤ñ¹ï
2. ³W®æÄæ¦ìY¦³ªÅ¥Õ¦r¤¸¡A«h²¾°£ªÅ¥Õ¦r¤¸¦A¤ñ¹ï
3.Y«D¦¹4ºØ®æ¦¡¡A«h¨Ì«~¸¹§ì¸ê®Æ(³æµ§)¡A¤£¼Ò½k¤ñ¹ï
4.¬d¸ßªº¸ê®Æ¦C¨ì¤u§@ªí"¦¨ªG"
µ{¦¡¦p¤U
Sub ¼Ò½k¬d¸ß()
Dim Rg As Range, ¬d§ä½d³ò As Range, ¦¹ªí As Object
Dim Arr, R&, Key$, MD$, Csft&, K2$, Addr0$, R1&
[¦¨ªG!A1].CurrentRegion.Offset(1).ClearContents
Arr = Range([D1], [A1].End(4))
Set ¦¹ªí = ActiveSheet: Sheets("¦¨ªG").Activate
R1 = 1: [A1:D1] = Array("«~¸¹", "«~¦W", "³W®æ", "¼Æ¶q")
For R = 2 To UBound(Arr)
MD = Replace(Arr(R, 3), " ", "") '²¾°£ªÅ¥Õ(¤£ºÞ¦bþÓ¦ì¸m)
Key = ""
If MD Like "####*" Then Key = Left(MD, 4)
If MD Like "[A-Z]####*" Then Key = Left(MD, 5)
If MD Like "###-####*" Then Key = Left(MD, 8)
If MD Like "[A-Z]##-[A-Z]###*" Then Key = Left(MD, 8)
If Key <> "" Then 'Y³W®æ²Å¦X¤Wz4ºØ®æ¦¡¡A«h¼Ò½k¬d¸ß
Set ¬d§ä½d³ò = [®w¦s!C:C]: Csft = -2: K2 = "*"
Else 'Y³W®æ¤£²Å¦X¤Wz4ºØ®æ¦¡¡A§ï¬d«~¸¹(¶È³æµ§)
Set ¬d§ä½d³ò = [®w¦s!A:A]: Csft = 0: K2 = "": Key = Arr(R, 1)
End If
With ¬d§ä½d³ò
Set Rg = .Find(Key & K2, , , xlWhole)
If Not Rg Is Nothing Then Addr0 = Rg.Address
Do While Not Rg Is Nothing
R1 = R1 + 1
Rg.Resize(, 4).Offset(, Csft).Copy Cells(R1, "A")
Set Rg = .FindNext(Rg)
If Rg.Address = Addr0 Then Exit Do
Loop
End With
Next R
End Sub
Àɮצp¤U
¦C¥X§ó¦h¸ê®Æ0822.rar (19.34 KB)
|
|