excel循环从其他工作簿复制数据

发表于 更新于 分类于 Waline：

excel循环从其他工作簿复制数据

现在工作这里，他们查询单井数据都是在浏览器上，输井号和日期，从网络的数据库查询，返回的数据再输出到网页上。

网页上只是最简单的用表格显示数据，不管是看，还是算，都显得太苍白。之前习惯了在微软的 Excel 里操作，所以打算把2015年之内的数据全粘到一个 Excel 表格里。

文件内部的格式基本一致，文件名和存储路径都很规整，所以直接在固定区域来回的复制粘贴就行了。不会别的办法，用两层循环，实际使用，执行效率可以忍受。

于是有了下面这段丑的代码。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Sub test()
Application.ScreenUpdating = False
Application.ShowWindowsInTaskbar = False
yueZ = Array("一", "二", "三", "四", "五", "六", "七", "八", "九")
yueA = Array("1", "2", "3", "4", "5", "6", "7", "8", "9")
yueMax = Array(31, 28, 31, 30, 31, 30, 31, 31, 5)
myCount = 0
For i = 1 To 1
    For j = 1 To 14
    If j < 10 Then
    havezero = "0"
    Else
    havezero = Null
    End If
    fname = "E:\综合日报表\综合日报\2015年综合日报\" & yueZ(i - 1) & "月\采油五区生产综合日报" & yueA(i - 1) & "." & havezero & j & ".xls"
    Set wb = Workbooks.Open(fname, 0, ture)
    ThisWorkbook.Sheets(1).Range("a" & 6 + myCount * 117 & ":a" & 122 + myCount * 117) = "2015-" & yueA(i - 1) & "-" & j
    wb.Sheets(4).Range("a6:d122").Copy Destination:=ThisWorkbook.Sheets(1).Range("b" & 6 + myCount * 117 & ":e" & 122 + myCount * 117)
    wb.Sheets(4).Range("e6:an122").Copy Destination:=ThisWorkbook.Sheets(1).Range("g" & 6 + myCount * 117 & ":ao" & 122 + myCount * 117)
    wb.Close False
    myCount = 1 + myCount
    Next
Next
For i = 1 To 1
    For j = 15 To yueMax(i - 1)
    If j < 10 Then
    havezero = "0"
    Else
    havezero = Null
    End If
    fname = "E:\综合日报表\综合日报\2015年综合日报\" & yueZ(i - 1) & "月\采油五区生产综合日报" & yueA(i - 1) & "." & havezero & j & ".xls"
    Set wb = Workbooks.Open(fname, 0, ture)
    ThisWorkbook.Sheets(1).Range("a" & 6 + myCount * 117 & ":a" & 122 + myCount * 117) = "2015-" & yueA(i - 1) & "-" & j
    wb.Sheets(1).Range("a6:an122").Copy Destination:=ThisWorkbook.Sheets(1).Range("b" & 6 + myCount * 117 & ":ao" & 122 + myCount * 117)
    wb.Close False
    myCount = 1 + myCount
    Next
Next
For i = 2 To 9
    For j = 1 To yueMax(i - 1)
    If j < 10 Then
    havezero = "0"
    Else
    havezero = Null
    End If
    fname = "E:\综合日报表\综合日报\2015年综合日报\" & yueZ(i - 1) & "月\采油五区生产综合日报" & yueA(i - 1) & "." & havezero & j & ".xls"
    Set wb = Workbooks.Open(fname, 0, ture)
    ThisWorkbook.Sheets(1).Range("a" & 6 + myCount * 117 & ":a" & 122 + myCount * 117) = "2015-" & yueA(i - 1) & "-" & j
    wb.Sheets(1).Range("a6:an122").Copy Destination:=ThisWorkbook.Sheets(1).Range("b" & 6 + myCount * 117 & ":ao" & 122 + myCount * 117)
    wb.Close False
    myCount = 1 + myCount
    Next
Next
Application.ShowWindowsInTaskbar = True
Application.ScreenUpdating = True
End Sub