只要是零的就不出现在对应的表格中

liu2004

wengjl

Sub test()
   
    For i = 3 To 26
      clmc = ""
      slhj = ""
      For jj = 3 To 5
        If Cells(i, jj).Value = 0 Then
        
        Else
          clmc = clmc & IIf(jj = 3, "HB", IIf(jj = 4, "DM", "STS")) & "+"
          slhj = slhj & Cells(i, jj).Value & "张+"
         
        End If
      Next jj
      Cells(i, 8).Value = Mid(clmc, 1, Len(clmc) - 1)
      Cells(i, 9).Value = Mid(slhj, 1, Len(slhj) - 1)
    Next i   
End Sub
测试通过

陆离Lowry

。。。。。。。。。。。

ykcbf1100

你试一下。

liu2004

ykcbf1100 发表于 2022-11-17 13:36
你试一下。

  谢谢！！！！！

gwjkkkkk

    Dim arr, i&, j&, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    arr = [a2].CurrentRegion
    For i = 2 To UBound(arr)
      dic.RemoveAll
      For j = 3 To UBound(arr, 2)
         If arr(i, j) <> 0 Then
            dic(arr(1, j)) = arr(i, j) & "张"
         End If
      Next j
      arr(i, 1) = Join(dic.keys, "+"): arr(i, 2) = Join(dic.items, "+")
      arr(1, 1) = "材料": arr(1, 2) = "数量合计"
    Next i
    [H2].Resize(UBound(arr), 2) = arr
    Set dic = Nothing
    Beep

gwjkkkkk

请参考 附件 。。。