|
注：在View -> Toolbar -> View 下調(diào)出編輯，可以看到“Comment Block”
Shift + F8 調(diào)試下一行
Alt + F8 調(diào)出宏
字符串，數(shù)值在定義之后，可以直接賦值
Workbooks 集合包含 Microsoft Excel 中所有當(dāng)前打開(kāi)的 Workbook 對(duì)象。
application.transpose 轉(zhuǎn)置
WorksheetFunction.transpose
找值
http://zhidao.baidu.com/question/180864693.html
下面是最終版本，能實(shí)現(xiàn)按年份匹配的
Sub Mycopy()
Dim n As Integer
Dim companylist As Range
Dim companyname As Object
Dim SourceBook As Workbook
Dim SourceSheet As Worksheet
Dim myrange As String
n = 2
ThisWorkbook.Activate
Set companylist = Range("B2:B214")
For Each companyname In companylist
Path = "C:\Users\WilliamDong\Dropbox\數(shù)據(jù)\EXCEL\" & companyname & ".xlsx"
If Dir(Path) <> "" Then
Set mydictionary = CreateObject("Scripting.Dictionary")
Set SourceBook = Workbooks.Open(Path, 0, True)
Set SourceSheet = SourceBook.Worksheets(1)
For i = 2 To 9 Step 1 ' C2:C9 所需數(shù)據(jù)的年份范圍
If SourceSheet.Range("C" & i) <> "" Then
mydictionary.Add SourceSheet.Range("C" & i).Value, SourceSheet.Range("L" & i).Value
End If
Next i
dic_keys = mydictionary.keys
dic_items = mydictionary.items
' 下面遍歷字典，把值拿出來(lái)賦給另一個(gè)Excel表中對(duì)應(yīng)的位置E2:L2,對(duì)應(yīng)2005~~2012
For j = 0 To mydictionary.Count - 1
Dim indexNum As String
Select Case dic_keys(j)
Case 2005
indexNum = "E" & n
Case 2006
indexNum = "F" & n
Case 2007
indexNum = "G" & n
Case 2008
indexNum = "H" & n
Case 2009
indexNum = "I" & n
Case 2010
indexNum = "J" & n
Case 2011
indexNum = "K" & n
Case 2012
indexNum = "L" & n
End Select
ThisWorkbook.Worksheets(1).Range(indexNum) = dic_items(j)
Next
SourceBook.Close False
Else
End If
n = n + 1
Next companyname
End Sub
最終的（沒(méi)能實(shí)現(xiàn)按不同年份匹配）
Sub Mycopy()
Dim n As Integer
Dim companylist As Range
Dim companyname As Object
Dim SourceBook As Workbook
Dim SourceSheet As Worksheet
Dim myrange As String
n = 2
ThisWorkbook.Activate
Set companylist = Range("B2:B214")
For Each companyname In companylist
Path = "C:\Users\WilliamDong\Dropbox\數(shù)據(jù)\EXCEL\" & companyname & ".xlsx"
If Dir(Path) <> "" Then
Set SourceBook = Workbooks.Open(Path, 0, True)
Set SourceSheet = SourceBook.Worksheets(1)
RANGE_ = SourceSheet.Range("L2:L9")
myrange = "E" & n & ":" & "L" & n
ThisWorkbook.Activate
ThisWorkbook.Worksheets(1).Range(myrange) = WorksheetFunction.Transpose(RANGE_) '寫入數(shù)據(jù)
SourceBook.Close False
Else
End If
n = n + 1
Next companyname
End Sub
之前（1）
在Excel表1中寫入如下宏
Sub CopyData()
Dim r1 As Range
Dim r2 As Range
Dim w As Workbook
ThisWorkbook.Activate
Set r1 = ThisWorkbook.Sheets(1).[a1]
Set r2 = ThisWorkbook.Sheets(1).[c1]
Set w = Workbooks.Open(ThisWorkbook.Path & "\Test2.xlsx") ‘Test2是另一個(gè)Excel表
w.Sheets(1).[b1] = r1
w.Sheets(1).[b2] = r2
w.Save
w.Close
End Sub
之前（2）
Sub Mycopy()
Dim FSO As Object
Dim SourceFolder As Object
Dim FileItem As Object
Dim FileItemToUse As Object
Dim SourceFolderName As String
Dim n As Integer
Dim myrange As String
n = 2
SourceFolderName = "C:\Users\William\Dropbox\數(shù)據(jù)\EXCEL"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
For Each FileItem In SourceFolder.Files
'下面就可接著寫打開(kāi)文件讀取數(shù)據(jù)再寫入的語(yǔ)句了,如下:
fn = FileItem
Workbooks.Open Filename:=fn
Worksheets(1).Select '假設(shè)你讀取SHEET1的數(shù)據(jù)
RANGE_ = Range("L2:L9") '需要數(shù)據(jù)的區(qū)域,自己修改
ThisWorkbook.Activate '這個(gè)是新表的文件名,自己修改下
Worksheets(1).Select '打開(kāi)第幾個(gè)文件就選擇SHEET幾,如果沒(méi)有可用ADD代碼添加
myrange = "E" & n & ":" & "L" & n
Range(myrange) = RANGE_ '寫入數(shù)據(jù)
Workbooks(2).Close
n = n + 1
'End If
Next FileItem
End Sub
底下是網(wǎng)上參考
'這段代碼是讀取一個(gè)文件夾下的所有文件,也可以根據(jù)擴(kuò)展名篩選其它格式的.
'有了文件名,就是打開(kāi)文件,獲得每個(gè)文件的SHEET名字.然后寫到你想要的地方
Sub Macro1()
Dim myDialog As FileDialog, oFile As Object, strName As String, n As Integer
Dim FSO As Object, myFolder As Object, myFiles As Object ,Dim fn as String
Set myDialog = Application.FileDialog(msoFileDialogFolderPicker)
n = 1
With myDialog
If .Show <> -1 Then Exit Sub
Set FSO = CreateObject("Scripting.FileSystemObject") '這是文件夾選擇,點(diǎn)選到你存放文件的那個(gè)
Set myFolder = FSO.GetFolder(.InitialFileName)
Set myFiles = myFolder.Files
For Each oFile In myFiles
strName = UCase(oFile.Name)
strName = VBA.Right(strName, 3)
If strName = "xls" Or strName = "XLS" Then '這是擴(kuò)展名選擇
'下面就可接著寫打開(kāi)文件讀取數(shù)據(jù)再寫入的語(yǔ)句了,如下:
fn = myFolder & "\" & oFile.Name
Workbooks.Open Filename:=fn
Worksheets(1).Select '假設(shè)你讀取SHEET1的數(shù)據(jù)
RANGE_ = Range("A2:F50") '需要數(shù)據(jù)的區(qū)域,自己修改
Windows("外部表格數(shù)據(jù)自動(dòng)導(dǎo)入.xls").Activate '這個(gè)是新表的文件名,自己修改下
Worksheets(n).Select '打開(kāi)第幾個(gè)文件就選擇SHEET幾,如果沒(méi)有可用ADD代碼添加
Range("a2:f5") = RANGE_ '寫入數(shù)據(jù)
Workbooks(2).Close
n = n + 1
End If
Next
End With
End Sub
|
