求助，应该是数组转置的典型

lizhipei78

一键全自动生成

工序单价整理.rar (67.7 KB, 下载次数: 5)

2024-10-22 22:16 上传

点击文件名下载附件

张起灵1

lizhipei78 发表于 2024-10-22 22:16
一键全自动生成

多谢，我自己加工了一下
Sub TestSub()
    Dim dic
    Set dic = CreateObject("scripting.dictionary")
    arr = Sheet1.UsedRange.Value
    crr = Sheet3.UsedRange.Value
    For i = 1 To UBound(crr)
        dic(crr(i, 1)) = crr(i, 2)
    Next
    ReDim brr(1 To UBound(arr) * 10, 1 To 4)
    For i = 3 To UBound(arr)
        pinhao = arr(i, 1)
        For k = 2 To UBound(arr, 2) Step 2
            gongxu = arr(i, k)
            danjia = arr(i, k + 1)
            If Len(gongxu) > 0 And Len(danjia) > 0 Then
                j = j + 1
                brr(j, 1) = pinhao
                brr(j, 3) = gongxu
                brr(j, 4) = danjia
            End If
        Next
    Next
    For i = 1 To UBound(brr)
       If dic.exists(brr(j, 3)) Then
                    brr(i, 2) = dic(brr(i, 3))
                End If
    Next
    With Sheet2
        .UsedRange.Offset(2).ClearContents
        .Range("a3").Resize(j, 4).Value = brr
        .UsedRange.Offset(1).NumberFormatLocal = "@"
    End With
    MsgBox ("产品工序工价整理完毕") & Now, vbOKOnly + vbInformation, "温馨提示"
End Sub

lizhipei78

JSA 代码相对来说会少好多