[µ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

msmplay

¦^´_ 11# Hsieh


   H¤j~~~~´ú¸Õ¦¨¥\¤F³á!!!«D±`·PÁÂ~~~~~~~

msmplay

¦^´_ 11# Hsieh


    H¤j~~~~­º¥ý«D±`«D±`«D±`·PÁ§A¼ö¤ßÀ°¦£³á~~~~~~~¤£¹L´ú¸Õµ²ªG¬°¡G
ÀÉ1¡ylist*.xls¡zªºSheets(1)­n¶×¤J¬¡­¶¡ulist³øªí¡vªºA1¡G¦¨¥\¶×¤J
ÀÉ2¡yCCMOPQ*.xls¡zªºSheets(1)¸òSheets(2)­n¶×¤J¬¡­¶¡u¦³¸ê®Æ¡vªºB1¸ò¬¡­¶¡u¦³¸ê®Æ2¡vªºB1¡GSheets(1)¦¨¥\¶×¤J¡u¦³¸ê®Æ¡vªºB1¡ASheets(2)¥¼¶×¤J¦ý¶×¤J¦¨Sheets(1)¨ì¡u¦³¸ê®Æ2¡vªºB1
ÀÉ3¡yCCMOP_NAME*.xls¡zªºSheets(1)¸òSheets(2)­n¶×¤J¬¡­¶¡uµL¸ê®Æ¡vªºB1¸ò¬¡­¶¡uµL¸ê®Æ2¡vªºB1¡GSheets(1)¦¨¥\¶×¤J¡uµL¸ê®Æ¡vªºB1¡ASheets(2)¥¼¶×¤J¦ý¶×¤J¦¨Sheets(1)¨ì¡uµL¸ê®Æ2¡vªºB1
ÀÉ4¡y¹w¬ùªí³æ*.xls¡zªºSheets(4)­n¶×¤J¬¡­¶¡u¹w¬ùªí³æ¡vªºA1¡G¥¼¶×¤J

¥i¥H¦A½Ð§AÀ°¦£¬Ý¬Ý¶Ü~~~~~~

Hsieh

¦^´_ 10# msmplay
¸Õ¸Õ¬Ý

1. Sub ex()
   
2. Dim xlPath$
   
3. xlPath = ThisWorkbook.Path
   
4. Set fd = CreateObject("Scripting.Dictionary")
   
5. fa = Array("list", "CCMOP_NAME", "CCMOP", "¹w¬ùªí³æ")
   
6. sh = Array("list³øªí", "µL¸ê®Æ", "µL¸ê®Æ2", "¦³¸ê®Æ", "¦³¸ê®Æ2", "¹w¬ùªí³æ")
   
7. an = Array(1, 1, 2, 1, 2, 4)
   
8. For i = 0 To UBound(fa)
   
9. f = Dir(xlPath & "\" & fa(i) & "*.xls")
   
10. Do Until f = ""
    
11. If fd.exists(f) = False Then
    
12. fd(f) = f
    
13.    With Workbooks.Open(xlPath & "\" & f)
    
14.      If i = 0 Then
    
15.         ar = Array(1)
    
16.         ElseIf i = 1 Or i = 2 Then
    
17.         ar = Array(1, 2)
    
18.         Else
    
19.         ar = Array(4)
    
20.      End If
    
21.      For j = 0 To UBound(ar)
    
22.        With .Sheets(ar(j))
    
23.        If k = 0 Or k = 5 Then Rng = "A1" Else Rng = "B1"
    
24.           .Range("A1").CurrentRegion.Copy ThisWorkbook.Sheets(sh(k)).Range(Rng)
    
25.        End With
    
26.        k = k + 1
    
27.      Next
    
28.       .Close 0
    
29.    End With
    
30. End If
    
31. f = Dir
    
32. Loop
    
33. Next
    
34. End Sub

½Æ»s¥N½X

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

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

GBKEE

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

jeffrey628litw

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

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

msmplay

¦^´_ 5# GBKEE


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

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