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

[µo°Ý] ¦p¦ó¿é¤J¬Y¦r¦ê¦A·j¬d¦h­ÓÀɮ׽ƻs¨ì¥DÀɮפ¤

[µo°Ý] ¦p¦ó¿é¤J¬Y¦r¦ê¦A·j¬d¦h­ÓÀɮ׽ƻs¨ì¥DÀɮפ¤

¥»©«³Ì«á¥Ñ rcyw ©ó 2019-5-4 19:12 ½s¿è

½Ð±Ð¦U¦ì:

¥»¤H·Q±N©ñ¦b¦P¤@folder(e.g. C\Temp\..) ªº4­ÓÀɮפ¤(A,B,C,D), ¥ý¿é¤J·Q·j´Mªºcode, ¦A½Æ»s¨ì main.xls Àɪº«ü©w¦ì¸m...
¦Û¤vªºvbaµ{«×¯uªº¤Ó®t, §Æ±æ¦³°ª¤H«ü¾É¤@¤U, ¦Ûı¦n¹³«Ü½ÆÂø...¥ý·PÁÂ..

1. ¥ý¶}±Ò main ÀÉ,  «Ø¥ß¤@­Ó«ö¶s¼u¥X ©Î «Ø¥ß¤@­Ó¥i¿é¤Jªº¦ì, ¿é¤J·Q­n·j¬dªºcode, ¦p¿é¤J "KTRIG")
2. ¿é¤J«á, ·|¨ì C\Temp\ ¤¤, ·j¬d A,B,C,D Àɤ¤ªº¬Û¦P code, ¦A¶¶§Ç (xxxxxG11, xxxxxG1B, xxxxxG21,...) ¾ã¦æ½Æ»s¨ì«ü©wªº A File Data, B File Data, C File Data, D File Data ¤U,

A,B,C,D ÀɮתºÄæ¦ì³£¬O©T©wªº, ¦ýcodeªº¦¸§Ç§ó·s«á³£¤£·|¬O¶¶§Ç±Æ¦C. ©Mcode³£·|¤@¸ô¼W¥[ªº...

Main.zip (104.04 KB)

·j´M¤å¦r©ñ¦bRange("B2")
Sub ·j´M½Æ»s()
Dim FindTxt$, xA As Range, PH$, F, xRR As Range
Dim xB As Workbook, xS As Worksheet, xU As Range, N&
FindTxt = [B2]
If FindTxt = "" Then MsgBox "·j´M¤å¦r¥¼¿é¤J!  ": Exit Sub
Call ²M°£: Set xA = [A20]
PH = ThisWorkbook.Path  '¸ô®|>>¦Û¦æ§ï¬°C:\Temp
Application.ScreenUpdating = False
For Each F In Array("A", "B", "C", "D")
    Set xRR = Nothing: N = 1
    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)
    For i = 2 To xU.Rows.Count
        If InStr(xU.Cells(i, 1), FindTxt) > 0 Then
           N = N + 1: Set xRR = Union(xRR, xU.Rows(i))
        End If
    Next i
    xA = F & " File Data": xA.Resize(1, 4).Interior.ColorIndex = 4
    xRR.Copy xA(2): Set xA = xA(N + 3)
    xB.Close 0
101: Next
End Sub

·j´M¤Î½Æ»s.rar (95.97 KB)


======

TOP

¥ý·PÁª©¥D­ã´£³¡ªLªº¨ó§U...½Æ»s¨ì¥DÀɮתº³£¬O»Ý­nªº¸ê®Æ, ¦ý¥i¯à¬O¦Û¤v¤§«e¨S»¡²M·¡..

¦]¸ê®Æ¦bÀÉ®×A,B,C,D½Æ»s¨ì¥Dµ{¦¡«á, ¦Û¤vÁٻݥÎvlookup¨ú¥X¤À§O¦bA,B,C,D¬Û¦Pcode«áªº¤£¦P¸ê®Æ....
©Ò¥H§Æ±æºñ¦â¦æ 20,35,50,64..ªº " x File Data" ¬O¤£ÅÜ, .....A,B,C,D½Æ»s¥Xªº¸ê®Æ³£¦bºñ¦â¦æ¤§¤U, ¦³¨Çcode·|¬O¦³ªÅ¦æ, ´N¦pªþ¹Ï..

¿é¥X¨ì³o­Óµ²ªG¬O§_¥i¦æ©O?...¥ý·PÁÂ.

copy.jpg (68 KB)

copy.jpg

TOP

À³¸Ó¬O¹j15¦C, 20-35-50-65

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&
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)
    For i = 2 To xU.Rows.Count
        If InStr(xU.Cells(i, 1), FindTxt) > 0 Then 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)
    xB.Close 0
101: Next
End Sub

TOP

¯uªº«Ü·PÁ©M¨ØªAª©¥D­ã´£³¡ªLªºÀ°¦£, ³o»ò§Ö´N§ï¨ì¤F, ³o¥¿¬O¦Û¤v©Ò»Ý­nªº....

¦Û¤vªºµ{«×¹ê¦b¤Ó®t¤F, ­n¥[­¿§V¤O¤@¤U......

¦A¦¸·PÁÂ...

TOP

¥»©«³Ì«á¥Ñ rcyw ©ó 2019-5-6 21:22 ½s¿è

¥t¥~µo²{¦³¤@­Ó°ÝÃD....´N¬O¥ÑA,B,C,D·j´M¥X¨Ó ½Æ»s¨ì¥Dµ{¦¡¤¤,,..¤£¬O¶¶§Çªº.
¨Ò¦p: ·íAÀɳQ§ó·s¹L«á, ±Æ¦C¤£¬O¶¶§Çªº¸Ü..½Æ»s¥X¨Óªºµ²ªG·|¤£¬O¶¶§Ç..xxxxxG21, xxxxxG11, xxxxxG3B...

¦Û¤v¦h¥[¤F¤U¦Cªºµ{¦¡, ¤À§O¥ý±NA,B,C,D¥ý±Æ¦C¤@¦¸, ¤~°õ¦æª©¥D­ã´£³¡ªLªºµ{¦¡...³o¼Ë¥X¨Óªºµ²ªG´N¥i¥H4­ÓÀÉ®×¥X¨Óªº³£¬O¶¶§Ç....¿é¥X¨Óªº¼Æ¾Ú³£¬O¦Û¤v·Q­nªº....

    Workbooks.Open Filename:="C:\Temp\A.csv"
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("A").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("A").AutoFilter.Sort.SortFields.Add Key:= _
        Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("A").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Save
    ActiveWorkbook.Close SaveChanges:=True

¦ý³£·Q¾Ç²ß¤@¤U, ¬O§_¦³§ó¦nªº§ó§ï, ¤£»Ý¥ý±N·Q·j´MªºÀɮ׳v­Ó±Æ¦C, (e.g. xxxxxG11, xxxxxG1B, xxxxxG21...) ¥X¨Ó®Éªºµ²ªG´N¥i¥H"¶¶§Ç"¿é¥X¨Ó©O?

¥ý·PÁÂ...

TOP

¥»©«³Ì«á¥Ñ ­ã´£³¡ª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


========

TOP

¦A¦¸·PÁª©¥D­ã´£³¡ªL...­ì¨Ó´N³o¼Ë¥[¤F¤T¦æ¥ª¥k´N¤w¸g§ïÅܤF,

¯uªº«D±`·PÁÂ...

TOP

        ÀR«ä¦Û¦b : ½_ÁJµ²±o¶V¹¡º¡¡A¶V·|©¹¤U««¡A¤@­Ó¤H¶V¦³¦¨´N¡A´N­n¶V¦³Á¾¨Rªº¯ÝÃÌ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD