1.合并工作簿的宏
代码(合并工作簿)
1 Sub 合并工作簿() 2 3 Dim p As Integer 4 Dim s As Integer 5 Dim i As Integer 6 Dim hao As String 7 Dim fd As FileDialog 8 Dim strPath As String 9 10 Application.DisplayAlerts = False '关闭提示窗口 11 Set newshe = ThisWorkbook.Worksheets(1) '本工作簿的第一个工作表 12 Set template = ThisWorkbook.Worksheets(2) '临时工作表 13 newshe.Rows("2:1048576").Delete '删除工作簿的第一个工作表的所有数据(除了第一行标题外) 14 '右键按钮 选择控件格式 点击 属性 选择 对象位置和大小 选择不随单元格变化 点击确定即可 15 s = 0 16 17 '使用FileDialog对象选择文件夹 18 Set fd = Application.FileDialog(msoFileDialogFolderPicker) 19 '显示文件夹对话框 20 fd.Title = "港股合并,请选择数据所在文件夹,然后点击确定" 21 fd.InitialFileName = ThisWorkbook.Path '本工作当前路径 22 23 If fd.Show = -1 Then '用户选择了文件夹 24 strPath = fd.SelectedItems(1) 25 Else: strPath = "" 26 'MsgBox "您没有选择数据所在文件夹路径" 27 Exit Sub '退出程序下面执行 28 End If 29 30 Set fd = Nothing 31 '关闭屏幕更新，防止闪屏、加快代码运行Application.ScreenUpdating = FalseApplication.ScreenUpdating = FalseApplication.ScreenUpdating = False 32 na = Dir(strPath & "\*.xls") '需要合并的所有工作表都要事先保存在F:\数据\20120705\文件夹下 33 Do While na <> "" 34 template.Rows("1:10").Delete '将第1行至第10行删除 35 Set wb = Application.Workbooks.Open(strPath & "\" & na) 36 37 38 39 If InStr(wb.Worksheets(1).Cells(10, 1), "日期") > 0 And _ 40 InStr(wb.Worksheets(1).Cells(8, 1), "代號") > 0 And _ 41 InStr(wb.Worksheets(1).Cells(13, 1), "資產淨值(以交易貨幣計算)") > 0 And _ 42 InStr(wb.Worksheets(1).Cells(20, 1), "香港單位") > 0 And _ 43 InStr(wb.Worksheets(1).Cells(17, 1), "香港單位") > 0 Then 44 For i = 1 To 50 45 template.Cells(i, 1) = wb.Worksheets(1).Cells(10, (i * 3)).Value '第C列表示第3列 46 template.Cells(i, 2) = wb.Worksheets(1).Cells(8, (i * 3)).Value '代码 47 template.Cells(i, 3) = wb.Worksheets(1).Cells(13, i * 3).Value '单位净值 48 template.Cells(i, 4) = wb.Worksheets(1).Cells(20, i * 3).Value '资产净额总值 49 template.Cells(i, 5) = wb.Worksheets(1).Cells(17, i * 3).Value '已发行单位 50 Next 51 Else: MsgBox "格式已经变更，更改一下" 52 End If 53 template.UsedRange.Copy '复制数据 54 'ActiveCell.CurrentRegion.Select '选择区域(不知道多少行) 55 56 newshe.Activate 57 58 'Cells(s, 1) = wb.Name '写入数据所属的工作簿名字 59 's = s + 1 60 61 s = newshe.UsedRange.Rows.Count 62 63 s = s + 1 64 newshe.Cells(s, 1).Select 65 ActiveSheet.Paste '执行粘贴 66 wb.Close '关闭工作簿 67 na = Dir() '取下一个工作簿 68 Loop 69 Application.DisplayAlerts = True 70 newshe.Activate 71 72 '以下下进行格式调整 73 Columns("A:A").Select 74 Application.CutCopyMode = False 75 Selection.NumberFormatLocal = "yyyy-mm-dd" 76 Columns("B:B").Select 77 Selection.NumberFormatLocal = "00000" 78 79 80 Range("A1").Select 81 newshe.UsedRange.Select '全选 82 83 Call 匹配 84 ThisWorkbook.Worksheets(3).Activate 85 End Sub
2.匹配的宏
代码(匹配的宏)
1 Sub 匹配() '进行匹配 2 3 Dim exceldata1 As Variant '存放sheet1中的数据 4 Dim exceldata2 As Variant '存放最终结果 5 6 Dim LB1 As Integer, UB1 As Integer 7 Dim LB2 As Integer, UB2 As Integer 8 Dim Bin As Boolean '标记 判断是否找到匹配 找到则退出本层循环 9 Dim CharData As String 10 Dim i As Integer, j As Integer 11 12 13 Application.DisplayAlerts = False '关闭提示窗口 14 Set newshe = ThisWorkbook.Worksheets(1) '本工作簿的第一个工作表 15 Set result = ThisWorkbook.Worksheets(3) '存放结果表 16 17 result.Activate 18 '清除 最终结果中的内容 19 result.Columns("A:A").Select 20 Selection.ClearContents 21 result.Columns("C:C").Select 22 Selection.ClearContents 23 result.Columns("D:D").Select 24 Selection.ClearContents 25 result.Columns("E:E").Select 26 Selection.ClearContents 27 28 exceldata1 = newshe.UsedRange.Value 29 exceldata2 = result.UsedRange.Value 30 31 LB1 = LBound(exceldata1, 1) '通过 数组 获取第一维 即行数 32 UB1 = UBound(exceldata1, 1) 33 LB2 = LBound(exceldata2, 1) 34 UB2 = UBound(exceldata2, 1) 35 36 For i = LB1 To UB1 37 j = LB2 38 Bin = True 39 40 CharData = Trim(newshe.Cells(i, 2).Value) 41 Do While Bin = True And j <= UB2 42 If Trim(result.Cells(j, 2).Value) = CharData Then 43 result.Cells(j, 1) = newshe.Cells(i, 1).Value 44 result.Cells(j, 3) = newshe.Cells(i, 3).Value 45 result.Cells(j, 4) = newshe.Cells(i, 4).Value 46 result.Cells(j, 5) = newshe.Cells(i, 5).Value 47 Bin = False 48 Exit Do 49 End If 50 j = j + 1 51 Loop 52 Next i 53 54 result.Activate 55 '以下下进行格式调整 56 Columns("A:A").Select 57 Application.CutCopyMode = False 58 Selection.NumberFormatLocal = "yyyy-mm-dd" 59 Columns("B:B").Select 60 Selection.NumberFormatLocal = "00000" 61 62 result.UsedRange.Select '全选 63 End Sub