- ©«¤l
- 234
- ¥DÃD
- 19
- ºëµØ
- 0
- ¿n¤À
- 276
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows XP
- ³nÅ骩¥»
- office 2003
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2013-1-7
- ³Ì«áµn¿ý
- 2021-10-7
|
¦^´_ 5# qaqa3296
§âÀs¤jªºµ{¦¡×§ï¤@¤U
¨Ì»Ý¨Dª½±µ±NLeft©ñ¤Jµ{¦¡¤¤
³W®æªÅ¥Õ¥u¦n¥Î«~¸¹¬d¸ß
°õ¦æµ²ªG»P©Ò»Ý¬Û²Å
Sub ¼Ò½k¬d¸ß()
Dim Rg As Range, Addr0$, R1&
[K:N].ClearContents
[K1:N1] = Array("«~¸¹", "«~¦W", "³W®æ", "¼Æ¶q")
R1 = 1
With [®w¦s!A:C]
For Each a In Sheets("¥Ø¼Ð").Range([a2], [a2].End(4))
If a.Offset(, 2) <> "" Then
Set Rg = .Find(Left(a.Offset(, 2), 8) & "*", , , xlWhole)
Else
Set Rg = .Find(a, , , xlWhole)
End If
If Not Rg Is Nothing Then Addr0 = Rg.Address
Do While Not Rg Is Nothing
R1 = R1 + 1
If Rg.Column = 3 Then
Rg.Resize(, 4).Offset(, -2).Copy Cells(R1, "K")
Else
Rg.Resize(, 4).Copy Cells(R1, "K")
End If
Set Rg = .FindNext(Rg)
If Rg.Address = Addr0 Then Exit Do
Loop
Next
End With
End Sub |
|