- ©«¤l
- 218
- ¥DÃD
- 73
- ºëµØ
- 0
- ¿n¤À
- 290
- ÂI¦W
- 0
- §@·~¨t²Î
- WIN10
- ³nÅ骩¥»
- Office2010
- ¾\ŪÅv
- 20
- ©Ê§O
- ¤k
- µù¥U®É¶¡
- 2014-5-19
- ³Ì«áµn¿ý
- 2022-11-29
|
¦^´_ 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 |
|