vba将多个word文档合并单元格

1.VBA将多个WORD中表格批量汇总到同一excel文件中

WORD中的简历有规律的话，或者有标记的话，是比较容易解决的。 示例：

Sub test()

Dim mFolder As String

Dim i As Integer

mFolder = "f:\111" '修改这个地方就是存放文件的地方

[A1] = "路径"： [B1] = "文件名"

With Application.FileSearch

.NewSearch

.LookIn = mFolder

.SearchSubFolders = True

.Filename = "*.*"

If .Execute() > 0 Then

For i = 1 To .FoundFiles.Count

If .FoundFiles(i) <> ThisWorkbook.FullName Then

Call Write_In(.FoundFiles(i))

End If

Next i

Else

MsgBox "文件夹 " & mFolder & "中没有所需的文件"

End If

End With

End Sub

Sub Write_In(strFile As String)

Dim intStart As Integer, intEnd As Integer, iRow As Long

Dim strFileName As String

intStart = InStrRev(strFile, "\")

intEnd = InStrRev(strFile, ".")

strFileName = Mid(strFile, intStart + 1, intEnd - intStart - 1)

Application.ScreenUpdating = False

With Sheet1

iRow = .[a65536].End(xlUp).Row + 1

.Cells(iRow, 1) = strFile

.Cells(iRow, 2) = strFileName

End With

Application.ScreenUpdating = True

End Sub

2.用VBA EXCEL大量合并单元格,合并单元格内容保留

根据你的题目，我在如下的数据中，为你写了一段代码，在excel 2003中，测试通过

A B

水果 西瓜

芒果

荔枝

蔬菜 南瓜

冬瓜

北瓜

中瓜

宠物 鸡

鸭

鹅

金鱼

以下为代码：

Private Sub CommandButton1_Click()

Worksheets("sheet1").Cells(1, 10).Value = "=counta(b:b)"

z = Worksheets("sheet1").Cells(1, 10).Value

x = 0 '记录大类小类都存在的行数

y = "" '拼接字符串

For i = 1 To z

If Worksheets("sheet1").Cells(i, 1).Value > 0 And Worksheets("sheet1").Cells(i, 2).Value > 0 Then

If x > 0 And Len(y) > 0 Then

Range("B" & x & ":B" & i - 1).Select

With Selection

.HorizontalAlignment = xlGeneral

.VerticalAlignment = xlTop

.WrapText = True

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = True

End With

Worksheets("sheet1").Cells(x, 2).Value = Left(y, Len(y) - 1)

End If

x = i

y = Worksheets("sheet1").Cells(i, 2).Value & ","

End If

If Worksheets("sheet1").Cells(i, 1).Value = 0 And Worksheets("sheet1").Cells(i, 2).Value > 0 Then

y = y & Worksheets("sheet1").Cells(i, 2).Value & ","

End If

Worksheets("sheet1").Cells(i, 2).Value = ""

Next i

If x > 0 And Len(y) > 0 Then

Range("B" & x & ":B" & i).Select

With Selection

.HorizontalAlignment = xlGeneral

.VerticalAlignment = xlTop

.WrapText = True

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = True

End With

Worksheets("sheet1").Cells(x, 2).Value = Left(y, Len(y) - 1)

End If

End sub

如果 还有问题 可发信在我邮箱

3.求 合并多个表格的VBA程序

不明白再Q我吧，40194204 这个很简单的，以下是Excelhome的一个朋友写的代码： 要求把需要汇总的所有Excel文件放在当前汇总表所在文件夹下的一个叫“分表”的子文件夹中，然后在当前汇总表中依次按ALT+F11、Ctrl+R、回车，把下面的代码粘贴在右边一大片空白的区域后，按F5键，程序就开始汇总文件了，不要动它，等它提示汇总结束点确定，所有数据就汇总到当前汇总表里面了。

Sub temp() Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer Application.ScreenUpdating = False '冻结屏幕，以防屏幕抖动 myPath = ThisWorkbook.Path & "\分表\" '把文件路径定义给变量 myFile = Dir(myPath & "*.xls") '依次找寻指定路径中的*.xls文件 Do While myFile <> "" '当指定路径中有文件时进行循环 If myFile <> ThisWorkbook.Name Then Set AK = Workbooks.Open(myPath & myFile) '打开符合要求的文件 For i = 1 To AK.Sheets.Count aRow = AK.Sheets(i).Range("a65536").End(xlUp).Row tRow = ThisWorkbook.Sheets(1).Range("a65536").End(xlUp).Row + 1 'AK.Sheets(i).Select AK.Sheets(i).Range("a2:k" & aRow).Copy ThisWorkbook.Sheets(1).Range("a" & tRow) Next Workbooks(myFile).Close False '关闭源工作簿，并不作修改 End If myFile = Dir '找寻下一个*.xls文件 Loop Application.ScreenUpdating = True '冻结屏幕，此类语句一般成对使用 MsgBox "汇总完成，请查看！"， 64， "提示" End Sub。

4.如何把多个word窗口合成一

合并文档可以将多个文档快速合成为一个，它是Word提供的一个崭新功能，其使用方法是：打开合并前的源文档，单击“工具”菜单中的“比较并合并文档”命令。

在对话框中找到要合并的目标文档，单击“合并”旁边的下拉按钮，可以在菜单中选择即将执行的操作。假如您要在原始文档中显示比较结果，可以单击“合并”命令；若要在当前打开的文档中显示比较结果，应当单击“合并到当前文档”命令；要想在新文档中显示比较结果，就要选择“合并到新文档”命令。

5.如何使用VB实现多个excel表格合并在一个EXCEL表格里面

由于你描述得太简单了，所以，只能给你提供一个思路，请按照此思路，进行修改完善代码即可。

Sub FileJoin() Dim Wb As Workbook Dim cPath$, myFile$ cPath = ThisWorkbook.Path & "\"'获取本文件所在路径 '如果扩展名不是xls请修改为你实际的扩展名 myFile = Dir(cPath & "*.xls") Set Wb = ThisWorkbook Application.ScreenUpdating = False Do While myFile <> "" If myFile <> ThisWorkbook.Name Then With Workbooks.Open(cPath & myFile) '将子文件中的第一个工作表复制到本工作薄中 .Sheets(1).Copy after:=Wb.Sheets(Wb.Sheets.Count) .Close False End With End If myFile = Dir'在本文件夹下查找下一个xls扩展名的文件 Loop Application.ScreenUpdating = True MsgBox "汇总完毕！"， vbInformation， "提示"End Sub。

转载请注明出处51数据库 » vba将多个word文档合并单元格