求高手指正，批量生成清单件号后不按批次统计

zxsea_7426

  wdDoc.SaveAs "D:\" & Replace(Range("A" & j), "/", "-"), ".docx"
是不是少了个&
  wdDoc.SaveAs "D:\" & Replace(Range("A" & j), "/", "-") & ".docx"

LOYOTO

zxsea_7426 发表于 2022-8-28 20:29
wdDoc.SaveAs "D:\" & Replace(Range("A" & j), "/", "-"), ".docx"
是不是少了个&
  wdDoc.SaveAs "D: ...

加上以后可以了，但是只导出了最后一批，前面两批没有出来，每增加一批，都只是出现最后一批


     

LOYOTO

chxw68 发表于 2022-8-28 18:48
又改了一下，你试一下。

Public Sub 进货台账()
  Dim i%, r%
  Dim wdDoc As Word.Document
  Dim mWord As New Word.Application
  Application.ScreenUpdating = False
  Set d = CreateObject("scripting.dictionary")
  With Worksheets("今日供货清单")
    r = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("a2:d" & r)
    For i = 1 To UBound(arr)
      If Not d.Exists(arr(i, 1)) Then
        Set d(arr(i, 1)) = CreateObject("scripting.dictionary")
      End If
      d(arr(i, 1))(arr(i, 3)) = Empty
    Next
  End With
  Set wdDoc = mWord.Documents.Open(ThisWorkbook.Path & "\今日清单模板.docx")
  For Each aa In d.keys
    With wdDoc
      With .Tables(1)
        .Cell(1, 2).Range.Text = aa
        .Cell(4, 3).Range.Text = Join(d(aa).keys, "，")
      End With
      wdDoc.SaveAs "D:\" & Replace(Range("A" & i), "/", "-") & ".docx"
    End With
  Next
  wdDoc.Close False
  mWord.Quit
  Application.ScreenUpdating = True
End Sub

LOYOTO

chxw68 发表于 2022-8-28 18:48
又改了一下，你试一下。

谢谢老师，我也改了一下，代码给你回复了，现在导出来只有最后一批次，没有前面几个批次，希望老师研究下那里出问题了。

chxw68

LOYOTO 发表于 2022-8-28 22:29
Public Sub 进货台账()
  Dim i%, r%
  Dim wdDoc As Word.Document

胡乱修改！

chxw68

LOYOTO 发表于 2022-8-28 22:32
谢谢老师，我也改了一下，代码给你回复了，现在导出来只有最后一批次，没有前面几个批次，希望老师研究下 ...

字典中的关键字aa就是取的A列中的值，最后导出word文件时，只与字典有关，与表格无关了，自然与Range也无关了，你非要硬拉硬套个Range（“A” & i），真服了！

LOYOTO

chxw68 发表于 2022-8-29 06:46
字典中的关键字aa就是取的A列中的值，最后导出word文件时，只与字典有关，与表格无关了，自然与Range也无 ...

那么，请问老师，如何写才能使导出的WORD与表格相关联？？ 改了以后可以正常运行，不知怎么回事，运行只提取了最后一批。

LOYOTO

LOYOTO 发表于 2022-8-29 09:55
那么，请问老师，如何写才能使导出的WORD与表格相关联？？

抱歉啊，老师，由于工作需要，必须与表格相关联

zxsea_7426

LOYOTO 发表于 2022-8-29 10:00
抱歉啊，老师，由于工作需要，必须与表格相关联

表格里面的数据已经放到字典里去啊。

LOYOTO

zxsea_7426 发表于 2022-8-29 11:21
表格里面的数据已经放到字典里去啊。

放进去了，        Set d(arr(i, 1)) = CreateObject("scripting.dictionary")     问题在这里，r = Range("A1").End(xlup).Row  它只提取最后一个有效值，不能提取全部