求大神改一下代码

绝世梦想

现在系统有两个问题，一是：批量生成物料卡后每张物料卡的材料名称后面的规格要去掉；二是：在保证同样材料名称的材料编号一致的情况下，材料编号不要跳跃，请解决一下这两个问题，不胜感谢

jiangxiaoyun

一大堆代码，，不知道那个跟那个。。。。

绝世梦想

jiangxiaoyun 发表于 2023-3-21 19:30
一大堆代码，，不知道那个跟那个。。。。

鼠标右键调出命令按钮  批量生成物料卡

洋务德雷

看了你的这个代码，代码确实是太罗嗦了。回头一看，原来你是WPS。难怪这么麻烦呢。
如果是office版本的话。或许借助自定义选项卡，还有SQL+VBA来解决你的问题会更加简便。
只可惜你是WPS，没有办法帮到你。不过上面有很多代码还是我还是可以借鉴的。

mmwwdd

实际很多call是一条语句就能完成的，而且你的call不具备通用性

绝世梦想

自动编号的问题解决，只需将 批量生成物料登记卡模块中的这一部分改成如下代码即可
A = .Range("B" & n) '生成入库单自动编号
If .Range("E" & n + 28) = .Range("E" & n) Then
.Range("B" & n + 28) = .Range("B" & n) '生成单号
Else
.Range("B" & n + 28) = "WL" & Mid(A, 3, 6) & Format(Right(A, 4) + 1, "000")   '生成单号
End If   '生成单号

怎么把物料卡中材料名称中的规格去掉只保留规格型号前的部分？

绝世梦想

物料卡表体内容是通过材料名称及规格型号得到的，当生成物料卡后要将第一次的材料名称后的规格型号去掉，突然间发现可以通过截取字符的长度得到，写如下代码问题得到完美解决：

.Range("E" & n) = Mid(.Range("E" & n), 1, Len(.Range("E" & n)) - Len(.Range("E" & n + 1)))   '通过截取字符长度二次获取材料名称

绝世梦想

批量生成物料登记卡的完整代码如下：


Sub 批量生成物料登记卡()
On Error Resume Next
Application.ScreenUpdating = False

  Dim r%, i%
  Dim arr, brr, cc, t, crr
  Dim d As Object
  Set d = CreateObject("scripting.dictionary")
  
With Worksheets("汇总表")
    r = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("A2:J" & r)
End With
  
  For i = 1 To UBound(arr)
    If Not d.exists(arr(i, 9)) Then
      Set d(arr(i, 9)) = CreateObject("scripting.dictionary")
    End If
    d(arr(i, 9))(0) = d(arr(i, 9))(0) + 1
    p = Int((d(arr(i, 9))(0) - 1) / 19) + 1                   '模板表体为15行
    m = (d(arr(i, 9))(0) - 1) Mod 19 + 1                      '模板表体为15行
    If Not d(arr(i, 9)).exists(p) Then                         '关健字在数据源中的列数
      ReDim brr(1 To 19, 1 To 10)                               '定义一个15行9列的二维数组
    Else
      brr = d(arr(i, 9))(p)
    End If
    brr(m, 1) = m
    For j = 4 To 10                                          '从取数的第列算起到取数的最后一列
      brr(m, j) = arr(i, j - 2)                         '取出的数放在j+1列,从数据源的j+2列开始数据
    Next
    d(arr(i, 9))(p) = brr
  Next
  
  With Worksheets("物料登记卡")
    .Cells.Clear
  End With
  
  r1 = 1
  With Worksheets("登记卡模板")
    For Each aa In d.keys
      For Each bb In d(aa).keys
        If bb <> 0 Then
          brr = d(aa)(bb)
          .Cells(2, 5) = aa                                           '模板表头取数的行列数
           .Cells(7, 1).Resize(UBound(brr), UBound(brr, 2)) = brr     '模板表体取数的行列数
           
           .Cells(3, 2) = .Cells(8, 7)
           If .Cells(8, 7) = "" Then: .Cells(3, 2) = .Cells(7, 7)
          .Cells(3, 5) = .Cells(8, 4)
          If .Cells(8, 4) = "" Then: .Cells(3, 5) = .Cells(7, 4)
         
          .[D7:D26].ClearContents
          .[G7:G26].ClearContents
          .[A5] = Year(.[E8]) & "年"
         
      For i = 0 To 19
     .Range("A" & 7 + i) = Month(.Range("E" & 7 + i))
     .Range("B" & 7 + i) = Day(.Range("E" & 7 + i))
      Next

.[B2] = "WL" & Year(.[E8]) & Month(.Range("E" & 8)) & "0001"  '第一张表的单据编号
   
   
   .Range("F7:J26").Copy .[C7]
   .Range("E7:G26").Copy .[D7]
   
   .[H:J].ClearContents
   .[G7:G26].ClearContents
   .[A5:G26].Borders.LineStyle = 1  '加框线
   
   
  If .Range("B3") Like "件(*)" Then    '假如计量单位有件
    .Range("M7") = Len(.Range("B3"))
   Set s = .Range("M7")
  If s = 5 Then
.Range("N7") = Mid(.Range("B3"), 3, 1)
.Range("F7") = .Range("F7") / .Range("N7")
  .Range("F8") = "=F7+D8-E8"
.Range("F8:F" & .Cells(Rows.Count, 3).End(xlUp).Row + 1).FillDown

Else
.Range("N7") = Mid(.Range("B3"), 3, 2)
.Range("F7") = .Range("F7") / .Range("N7")
  .Range("F8") = "=F7+D8-E8"
.Range("F8:F" & .Cells(Rows.Count, 3).End(xlUp).Row + 1).FillDown
End If  '假如计量单位有件
Else
.Range("N7") = 1
.Range("F7") = .Range("F7") / .Range("N7")
.Range("F8") = "=F7+D8-E8"
.Range("F8:F" & .Cells(Rows.Count, 3).End(xlUp).Row + 1).FillDown
End If
   If .Range("C7") = "期初余额" Then: .Range("A7:B7").ClearContents
   .Range("A" & .Cells(Rows.Count, 3).End(xlUp).Row + 1 & ":G26").ClearContents
    .Range("A1:G26").Copy Worksheets("物料登记卡").Cells(r1, 1)
          r1 = r1 + 28   '一张入库单的总行数是21行
         
        End If
        
     Next
    Next
   
End With
  

With Worksheets("物料登记卡")
For m = 0 To r1 / 26                                                  '第一张入库单的表体最后一行行号是19
n = 28 * m + 2
t = Sheets("汇总表").[I:I].Find(.Range("E" & n), , , , , xlNext).Row

   .Range("E" & n) = Sheets("汇总表").Cells(t, 1)
  
   
If .Range("E" & n) = .Range("E" & n + 28) Then: .Range("F" & n + 33) = .Range("F" & n + 23) + .Range("D" & n + 33) - .Range("E" & n + 33)

A = .Range("B" & n) '生成入库单自动编号
If .Range("E" & n + 28) = .Range("E" & n) Then
.Range("B" & n + 28) = .Range("B" & n) '生成单号
Else
.Range("B" & n + 28) = "WL" & Mid(A, 3, 6) & Format(Right(A, 4) + 1, "000")   '生成单号
End If   '生成单号



.Columns("D:F").Select             '单元格范围去零值
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole '单元格范围去零值


.Range("E" & n) = Mid(.Range("E" & n), 1, Len(.Range("E" & n)) - Len(.Range("E" & n + 1)))   '通过截取字符长度二次获取材料名称


Next
End With
Application.ScreenUpdating = True
MsgBox "物料卡生成成功": Sheets("物料登记卡").Select
End Sub