[µo°Ý] vba¶}±Ò¨Ã§ì¨ú«ü©w¸ê®Æ§¨¤ºÃöÁä¦rÀÉ®×&¬¡­¶¦WºÙ¸ê®Æ

msmplay

¤U¸ü (34.57 KB)

2018-2-6 22:44

¤U¸ü (9.15 KB)

2018-2-6 22:44

»¡©ú:
«ö¤U¡i«ö¶s1¡j®É¡A¦Û°Ê¶}±Ò«ü©w¸ê®Æ§¨¤ºÀɮסylist20180206135132.xls¡z ¡A¨Ã±N¬¡­¶¦WºÙ¡ulist20180206135132¡vA:Z¸ê®Æ¶K¦Ü¦¹¬¡­¶A1¡A¦A±NÀɮסylist20180206135132.xls¡zÃö³¬

¹J¨ì°ÝÃD:
Àɮסylist20180206135132.xls¡z°£¤F list ¬°©T©w¦r¦ê¡A«á­±ªº¤é´Á®É¶¡¼Æ¦r§¡¤£©T©w¡A¥]§tÀɮפºªº¬¡­¶¦WºÙ¤]¬O¤@¼Ë¥u¦³ list ¬°©T©w¦r¦ê¡A«á­±ªº¤é´Á®É¶¡¼Æ¦r§¡¤£©T©w
¦]¦¹¥¨¶°¦b¼gªº®É­Ô§Æ±æ¥i¥H§ï¬°¶}±Ò«ü©wÃöÁä¦rÀɦW¡ylist¡zªºÀɮסA¨Ò¦plist201802081532¡Blist201803290915¡K¥H¦¹Ãþ±À¡A¥u­nÀɦW¦³¡ylist¡zÃöÁä¦r§Y²Å¦X±ø¥ó¡A¬¡­¶¦WºÙ¤]¬O¤@¼Ë

´£¿ô:
«ü©w¸ê®Æ§¨¤º¤£¥u¤@­ÓÀɮסA©Ò¥H¤£¯à¤£«ü©wÀɦW¡A§_«h¦³¥i¯à¶}¨ì§OªºÀɮפF¡A¥H¤W¨D¸Ñ~~~~~~~~~~


´ú¸Õ.rar (19.28 KB)

¤U¸ü¦¸¼Æ: 47

2018-2-6 22:44

GBKEE

¦^´_ 1# msmplay

¦Û°Ê¶}±Ò«ü©w¸ê®Æ§¨¤ºÀɮסylist*.xls¡z²Ä¤@­Ó¤u§@ªíªº A:Z¸ê®Æ ½Æ»s¨ì¬¡­¶[list³øªí]AÄæ¡A¦A±NÀɮסylist*.xls¡zÃö³¬


   

1. Option Explicit
   
2. Sub Ex()
   
3.   Dim xDir As String, xPath As String, xWb As Workbook
   
4.   xPath = ThisWorkbook.Path
   
5.   xDir = Dir(xPath & "\list*.xls", vbDirectory)
   
6.   Do While xDir <> ""
   
7.     Set xWb = Workbooks.Open(xPath & "\" & xDir)
   
8.     With ThisWorkbook.Sheets("list³øªí").Range("A1").End(xlDown)
   
9.         If .Row = .Parent.Rows.Count Then
   
10.             xWb.Sheets(1).UsedRange.Copy .Cells.End(xlUp)
    
11.         Else
    
12.             xWb.Sheets(1).UsedRange.Copy .Cells.Offset(1)
    
13.         End If
    
14.    
    
15.   
    
16.     End With
    
17.     xWb.Close
    
18.     xDir = Dir
    
19.   Loop
    
20. End Sub

½Æ»s¥N½X

msmplay

¦^´_ 2# GBKEE


   G¤j«D±`·PÁÂÀ°¦£~~~~~´ú¸Õ¤w¦¨¥\³á!!!¦A¦¸·PÁ£°

msmplay

¦^´_ 2# GBKEE


   G¤j~~~~~¤£¦n·N«ä¡A¤p©f¦n¹³¹J¨ì¤F¤@­Ó¶WÄøªº°ÝÃD­C!!!´N¬O¦pªG¦P®É¦³4­ÓÀÉ®×­n¶×¤J¡A¦Ó¥BÀɦW³£¤£¤@¼Ëªº®É­Ô¸Ó«ç»ò­×§ï©O???¨Ò¦p¡GÀÉ1¡ylist*.xls¡z­n¶×¤J¬¡­¶¡ulist³øªí¡vªºA1
ÀÉ2¡yCCMOP*.xls¡z­n¶×¤J¬¡­¶¡u¦³¸ê®Æ¡vªºB1
ÀÉ3¡yCCMOP_NAME*.xls¡z­n¶×¤J¬¡­¶¡uµL¸ê®Æ¡vªºB1
ÀÉ4¡y¹w¬ùªí³æ*.xls¡z­n¶×¤J¬¡­¶¡u¹w¬ùªí³æ¡vªºA1


¦]¬°§Úµo²{§Ú¦Û¤v«ç»ò§ï¦n¹³³£¤£¦æ¨º~~~~~

GBKEE

¦^´_ 4# msmplay

1. 'ÀÉ1¡ylist*.xls¡z­n¶×¤J¬¡­¶¡ulist³øªí¡vªºA1
   
2. 'ÀÉ2¡yCCMOP*.xls¡z­n¶×¤J¬¡­¶¡u¦³¸ê®Æ¡vªºB1
   
3. 'ÀÉ3¡yCCMOP_NAME*.xls¡z­n¶×¤J¬¡­¶¡uµL¸ê®Æ¡vªºB1
   
4. 'ÀÉ4¡y¹w¬ùªí³æ*.xls¡z­n¶×¤J¬¡­¶¡u¹w¬ùªí³æ¡vªºA1
   
5. Option Explicit
   
6. Sub Ex()
   
7.     Dim xDir As String, xPath As String, xWb As Workbook
   
8.     Dim Sh(), Dir_Ar(), xRng(), i As Integer
   
9.     Dir_Ar = Array("list*.xls", "CCMOP*.xls", "CCMOP_NAME*.xls", "¹w¬ùªí³æ*.xls")
   
10.     Sh = Array("list³øªí", "¦³¸ê®Æ", "µL¸ê®Æ", "¹w¬ùªí³æ")
    
11.     xRng = Arry("A1", "B1", "B1", "A1")
    
12.     xPath = ThisWorkbook.Path
    
13.     For i = 0 To UBound(Sh)
    
14.         xDir = Dir(xPath & "\" & Dir_Ar(i), vbDirectory)
    
15.         Do While xDir <> ""
    
16.             If i = 1 And InStr(UCase(xDir), "CCMOP_NAME") Then GoTo xNext
    
17.             Set xWb = Workbooks.Open(xPath & "\" & xDir)
    
18.             With ThisWorkbook.Sheets(Sh(i)).Range(xRng(i)).End(xlDown)
    
19.                 If .Row = .Parent.Rows.Count Then
    
20.                     xWb.Sheets(1).UsedRange.Copy .Cells.End(xlUp)
    
21.                 Else
    
22.                     xWb.Sheets(1).UsedRange.Copy .Cells.Offset(1)
    
23.                 End If
    
24.             End With
    
25.             xWb.Close
    
26. xNext:
    
27.             xDir = Dir
    
28.         Loop
    
29.     Next
    
30. End Sub

½Æ»s¥N½X

msmplay

¦^´_ 5# GBKEE


   G¤j¦n¼F®`£¬§A¡I¯u¬O¶W¯Å·PÁ§Aªº¼ö¦åÀ°¦££¬

jeffrey628litw

¦^´_  msmplay
GBKEE µoªí©ó 2018-2-11 08:33

    ¤j®v ¦³¤pµ§»~ ¡G²Ä11¦C Aeray ¬OArray ®@

GBKEE

¦^´_ 7# jeffrey628litw
²Ê¤ß¤j·N,·PÁ«ü¥X,

msmplay

¦^´_ 8# GBKEE


   «¢~~~~~G¤j¡A¹ï¤£°_~~~~¤p©f¤S¨Ó·Ð§A¤F¡A¦]¬°¤£ºÞ¦Û¤v«ç»ò¶Ã§ï´N¬O¤£·|¦¨¥\¡A¥i¥H¦A½Ð§AÀ°§Ú­Ó¦£¶Ü~~~~~~´N¬O¤W¦¸4#ªº°ÝÃD¡A¦pªG·Q¦A¦h¥[¥H¤U±ø¥ó¡A¨ì©³¸Ó«ç»ò­×§ï¤~¹ï©O¡H¡H¦]¬°µo²{¤£¦Pªº³øªí¦³¤£¦P»Ý¨D.........

¤@¼Ë¬O4­ÓÀÉ®×­n¶×¤J¡A¦ý±ø¥ó¦p¤U:
ÀÉ1¡ylist*.xls¡zªºSheets(1)­n¶×¤J¬¡­¶¡ulist³øªí¡vªºA1
ÀÉ2¡yCCMOP*.xls¡zªºSheets(1)¸òSheets(2)­n¶×¤J¬¡­¶¡u¦³¸ê®Æ¡vªºB1¸ò¬¡­¶¡u¦³¸ê®Æ2¡vªºB1
ÀÉ3¡yCCMOP_NAME*.xls¡zªºSheets(1)¸òSheets(2)­n¶×¤J¬¡­¶¡uµL¸ê®Æ¡vªºB1¸ò¬¡­¶¡uµL¸ê®Æ2¡vªºB1
ÀÉ4¡y¹w¬ùªí³æ*.xls¡zªºSheets(4)­n¶×¤J¬¡­¶¡u¹w¬ùªí³æ¡vªºA1

msmplay

¦^´_ 8# GBKEE


   G¤j~~~~§Ú¦Û¤v¤j·§¸Õ§ï¤F¤@¤U¡A¥i¥H½Ð§AÀ°§Ú¬Ý¬ÝÂæ¹ï¤£¹ï¶Ü¡H¦ý§Ú¤w¸gºÉ¤O¤F............µM«áCCMOPQ*.xls§Ú³Ì«á¦h¥[¤F¤@¤UQ¡A¦]¬°"CCMOPQ*.xls", "CCMOP_NAME*.xls"³o¨â­ÓÀɦW«e­±¤£·|§¹¥þ¤@¼Ë¡A©êºp

Option Explicit
Sub Ex()
    Dim xDir1 As String, xDir2 As String, xDir3 As String, xPath As String, xWb1 As Workbook, xWb2 As Workbook, xWb3 As Workbook
    Dim Sh1(), Sh2(), Dir_Ar1(), Dir_Ar2(), xRng1(), xRng2(), i As Integer
    Dir_Ar1 = Array("list*.xls", "CCMOPQ*.xls", "CCMOP_NAME*.xls")
    Dir_Ar2 = Array("CCMOPQ*.xls", "CCMOP_NAME*.xls")
    Sh1 = Array("list³øªí", "¦³¸ê®Æ1", "µL¸ê®Æ1")
    Sh2 = Array("¦³¸ê®Æ2", "µL¸ê®Æ2")
    xRng1 = Array("A1", "B1", "B1")
    xRng2 = Array("B1", "B1")
    xPath = ThisWorkbook.Path
    For i = 0 To UBound(Sh1)
        xDir1 = Dir(xPath & "\" & Dir_Ar1(i), vbDirectory)
        Do While xDir1 <> ""
            If i = UCase(xDir1) Then GoTo xNext1
            Set xWb1 = Workbooks.Open(xPath & "\" & xDir1)
            With ThisWorkbook.Sheets(Sh1(i)).Range(xRng1(i)).End(xlDown)
                If .Row = .Parent.Rows.Count Then
                    xWb1.Sheets(1).UsedRange.Copy .Cells.End(xlUp)
                Else
                    xWb1.Sheets(1).UsedRange.Copy .Cells.Offset(1)
                End If
            End With
            xWb1.Close
xNext1:
            xDir1 = Dir
        Loop
    Next
    For i = 0 To UBound(Sh2)
        xDir2 = Dir(xPath & "\" & Dir_Ar2(i), vbDirectory)
        Do While xDir2 <> ""
            If i = UCase(xDir2) Then GoTo xNext2
            Set xWb2 = Workbooks.Open(xPath & "\" & xDir2)
            With ThisWorkbook.Sheets(Sh2(i)).Range(xRng2(i)).End(xlDown)
                If .Row = .Parent.Rows.Count Then
                    xWb2.Sheets(2).UsedRange.Copy .Cells.End(xlUp)
                Else
                    xWb2.Sheets(2).UsedRange.Copy .Cells.Offset(1)
                End If
            End With
            xWb2.Close
xNext2:
            xDir2 = Dir
        Loop
    Next
    xDir3 = Dir(xPath & "\¹w¬ùªí³æ*.xls", vbDirectory)
    Do While xDir3 <> ""
    Set xWb3 = Workbooks.Open(xPath & "\" & xDir3)
    With ThisWorkbook.Sheets("¹w¬ùªí³æ").Range("A1").End(xlDown)
        If .Row = .Parent.Rows.Count Then
            xWb3.Sheets("¹w¬ùªí³æ¨t²Î¸ê®Æ").UsedRange.Copy .Cells.End(xlUp)
        Else
            xWb3.Sheets("¹w¬ùªí³æ¨t²Î¸ê®Æ").UsedRange.Copy .Cells.Offset(1)
        End If
            End With
            xWb3.Close
            xDir3 = Dir
        Loop
End Sub