- ©«¤l
- 2798
- ¥DÃD
- 10
- ºëµØ
- 0
- ¿n¤À
- 2854
- ÂI¦W
- 0
- §@·~¨t²Î
- ¡e²¤¡f
- ³nÅ骩¥»
- ¡e²¤¡f
- ¾\ŪÅv
- 100
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¡e²¤¡f
- µù¥U®É¶¡
- 2013-5-13
- ³Ì«áµn¿ý
- 2024-4-15
|
¥»©«³Ì«á¥Ñ ã´£³¡ªL ©ó 2019-5-8 10:03 ½s¿è
¦^´_ 6# rcyw
Sub ·j´M½Æ»s()
Dim FindTxt$, xA(4) As Range, PH$, F, xRR As Range
Dim xB As Workbook, xS As Worksheet, xU As Range, N&, V&
FindTxt = [B2]
If FindTxt = "" Then MsgBox "·j´M¤å¦r¥¼¿é¤J! ": Exit Sub
Call ²M°£
PH = ThisWorkbook.Path
For i = 1 To 4
Set xA(i) = Range("A" & Array(20, 35, 50, 65)(i - 1))
Next i
Application.ScreenUpdating = False
For Each F In Array("A", "B", "C", "D")
Set xRR = Nothing
If Dir(PH & "\" & F & ".csv") = "" Then GoTo 101
Set xB = Workbooks.Open(PH & "\" & F & ".csv")
Set xS = xB.Sheets(1): Set xU = xS.UsedRange
Set xRR = xU.Rows(1): V = 0
For i = 2 To xU.Rows.Count
If InStr(xU.Cells(i, 1), FindTxt) > 0 Then V = V + 1: Set xRR = Union(xRR, xU.Rows(i))
Next i
N = N + 1
xA(N) = F & " File Data": xA(N).Resize(1, 4).Interior.ColorIndex = 4
xRR.Copy xA(N)(2)
With xA(N)(3).Resize(V, xU.Columns.Count)
.Sort Key1:=.Item(1), Order1:=xlAscending, Header:=xlNo
End With
xB.Close 0
101: Next
End Sub
======== |
|