Home > Software engineering >  Help to do a, excel table more merged into a table of small tools, thanks
Help to do a, excel table more merged into a table of small tools, thanks

Time:09-27

The same directory, choose multiple excel workbook, to choose the work table format, merged into a table, a new workbook eventually merge table to add two fields: the name of the workbook table name

For example:


A book two tables: table 2 table 1
Table 1 B workbook two tables: table 2 table 3

Merged into C book a table on the basis of the original data, to increase the two fields:

Field 1: the name of the book
Field 2: table name

 

Thank you very much!!

An article on the web: I don't know much about:
A function code:
(vb) view plaincopy
1. The Option Explicit
2. '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
3. '* function name: MergeXlsFile
4. '* functions: automatic consolidation under the specified path all the.xls files into one file
5. '* parameter description: strPath: need to merge the XLS file path,
6. '* SheetCount: need to merge the individual worksheet in the workbook number
7. '* author: lyserver
8. '* contact: http://blog.csdn.net/lyserver
9. '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
10.
11. The Public Function MergeXlsFile (ByVal strPath As String, Optional ByVal SheetCount As Byte=1) As a Boolean
12. Dim As Integer I
13. Dim strSrcFile As String
14. Dim nRows As Long, nCols As Long, nSheets As Byte, nNewRows () As an Integer
15. Dim xlApp As Object, xlSrcBook As Object, xlNewBook As Object, xlSheet As Object, xlRange As Object
16.
17. On the Error Resume Next
18. If Right (strPath, 1) & lt;> "/" Then strPath=strPath & amp; "/"
19. 'if the number of working table in need to merge files less than 1 exit is
20. If SheetCount & lt; 1 Then the Exit Function
21. 'delete the original merge files under this path
22. If Dir (strPath & amp; "The combined file. XLS") & lt;> "" Then Kill strPath & amp; "The combined file. XLS"
23. 'get first.xls files
24. StrSrcFile=Dir (strPath & amp; "*. XLS")
25. 'if the file does not exist the exit
26. If Len (strSrcFile)=0 Then the Exit Function
27. The 'create an Excel instance
28. Set xlApp=CreateObject (" Excel. Application ")
29. 'to create a new workbook
30. Set xlNewBook=xlApp. Workbooks. Add
31. 'to adjust the new worksheet in the workbook number
32. ReDim nNewRows (1 To SheetCount)
33. For I=1 To SheetCount - xlNewBook. Sheets. Count
34. XlNewBook. Sheets. The Add, xlNewBook Sheets (xlNewBook. Sheets. Count)
35. The Next
With 36 'loop through the current path, all the.xls files
37. Do
38. The 'open to find the.xls files
39. The Set xlSrcBook=xlApp. Workbooks. Open (strPath & amp; StrSrcFile)
40. 'loop to copy the source the worksheet in the.xls files
41. NSheets=IIf (xlSrcBook. Sheets. Count & lt; SheetCount, xlSrcBook. Sheets. The Count, SheetCount)
42. For I=1 To nSheets
43. Set xlSheet=xlSrcBook. Sheets (I)
44. 'source.xls files in the practical data of the ith a worksheet ranks number
45. NRows=xlSheet. UsedRange. Rows. Count
46. NCols=xlSheet. UsedRange. Columns. The Count
47. 'use scope object to paste data source.xls files to merge the result file
48. Set xlRange=xlSheet. Range (xlSheet. Cells (1, 1), xlSheet. Cells (nRows, nCols))
49. XlRange. Select
50. XlRange. Copy
51. XlNewBook. Sheets (I) Cells (nNewRows (I) + 1, 1). The PasteSpecial & amp; HFFFFEFF8
52. 'the merged results file of the ith a worksheet rows
53. NNewRows (I)=xlNewBook. Sheets (1). UsedRange. Rows. Count
54. The Next
55. 'close open source.xls files
56. XlSrcBook. Close
57. 'continue to find next.xls files
58. StrSrcFile=Dir ()
59. The Loop Until Len (strSrcFile)=0
60. 'save and close the merge result file
61. XlNewBook. SaveAs strPath & amp; "The combined file. XLS"
62. XlNewBook. Close
63. 'exit Excel instance
64. XlApp. Quit
65. 'release resources
66. Erase nNewRows
67. The Set xlRange=Nothing
68. The Set xlSheet=Nothing
69. The Set xlNewBook=Nothing
70. The Set xlSrcBook=Nothing
71. If Err. Number=0 Then MergeXlsFile=True
72. The End Function
Second, call methods:
(vb) view plaincopy
1. The Sub main ()
2. If MergeXlsFile (" c:/temp ", 1) Then
3. MsgBox "the data has been successfully merged!" VbInformation, "tip"
4. The Else
5. MsgBox "data merging failure!" VbCritical, "tip"
6. End the If
7. End Sub

CodePudding user response:

Start recording macros in Excel 2003, manual, complete the required function end record macros, press Alt + F11 key, check just record macro corresponding VBA code,