|
楼主 |
发表于 2020-1-10 11:32
|
显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
本帖最后由 sblisb 于 2020-1-14 09:58 编辑
谢谢,麻烦你了
能不能不发图片呀,贴出代码好复制修改
Sub lqxs()
'引用 Microsoft Word15.0 Object Library
Dim Arr,i&, Str1$, Str2$, Brr, d, k, cz
Dim WD As New Word. Application, doc, ii%
Dim tt, aa, jj%, s3$, s4$
Application. ScreenUpdating=False
cz= Array("数据001","数据002","数据003","数据004")
Sheet1.Activate
Arr=[a1]. CurrentRegion
Brr=[e1]. CurrentRegion
Set d=CreateObject("Scripting.Dictionary")
For i=2 To UBound(Brr)
d(Brr(i, 1)) = d(Brr(i, 1)) & i & ","
Next
k =d.keys
With WD
.Visible=True
Set doc = .Documents. Open(ThisWorkbook. Path & "\模本.docx")
WD. Selection. HomeKey wdStory'将插入点移至文档开头
With doc
For i=2 To UBound(Arr)
If d. Exists(Arr(i, 1))Then
tt=d(arr(i,1)):s3="":s4=""
tt=Left(tt, Len(tt)-1)
If InStr(tt, "," ) Then
aa=Split(tt, ",")
For jj= 0 To UBound(aa)
If s3="" then
s3 = Brr(aa(jj), 2) & "仓库,"
s4 = Brr(aa(jj), 3) & "已发出,"
ElseIf jj < UBound(aa) Then
s3=s3 & "在" & Brr(aa(jj),2) & "仓库,"
s4=s4 & "有" & Brr(aa(jj),3) & "已发出,"
Else
s3=s3 & "在" & Brr(aa(jj),2)
s4=s4 & "有" & Brr(aa(jj),3)
End If
Next
Else
s3=Brr(tt, 2)
s4= Brr(tt, 4)
End If
For j = 0 To UBound(cz)
Str1 = cz(j)
If j<2 Then
Str2= Arr(i, j+1)
ElseIf j=2 Then
Str2=s3
Else
Str2=s4
End If
With WD. Selection. Find'使用查找命令
.ClearFormatting'不限定格式
.Forward = True
.Execute Str1'查找并选中str1及其后的段落标记
With WD. Selection. Find
.ClearFormatting
.Forward = True
.Replacement. Text = Str2
.Execute Replace: =wdReplaceAll
End With
End With
Next
. SaveAs ThisWorkbook.Path & "\订单号" & Arr(i,1) & ".docx"
.Close
End If
Next
End With
End With
Set WD= Nothing
Application. ScreenUpdating =True
End Sub
|
|