成本-计算202211

舟心ty

已于 2023-01-05 06:39:27 修改

阅读量66

点赞数

分类专栏：财务文章标签：其他

于 2022-12-06 11:21:53 首次发布

本文链接：https://blog.csdn.net/sx01117/article/details/128199838

版权

财务专栏收录该内容

9 篇文章 0 订阅

订阅专栏

Sub 成本计算()
Application.DisplayAlerts = False
Dim hangshu1, scrwd '成本计算表参数
Dim hangshu2, kjdyg '投料表参数
Dim j, hangshu3, crhangshu, kuaishu, zonghangshu, m, kjdyg2 '生产领料表参数
Dim biaoshu, jsq, k, n
Dim pds, p
Dim arr, brr, a, b, a1, b1, hangshu4
Dim zhongdianhang
hangshu1 = 63
pds = 0
 
For i = 3 To hangshu1
    scrwd = Sheets("当月入库成本核算202211").Range("A" & i)
    biaoshu = Sheets.Count
    Sheets.Add after:=Sheets(biaoshu)
    ActiveSheet.Name = scrwd
    jsq = jsq + 1
    With Sheets("投料单").Range("A1").CurrentRegion
        Sheets("投料单").Activate
        .AutoFilter
        .AutoFilter field:=3, Criteria1:=scrwd
        .AutoFilter field:=20, Criteria1:="<>0"
        '筛选出来的可见单元格区域
        Set kjdyg = Sheets("投料单").AutoFilter.Range.SpecialCells(xlCellTypeVisible)
        'Sheets("投料单").Range("A1:A50000").SpecialCells(xlCellTypeVisible).Select

        Sheets(scrwd).Activate
        kjdyg.Copy Sheets(scrwd).Range("A1")
        crhangshu = Sheets(scrwd).UsedRange.Rows.Count - 1
        hangshu3 = Sheets(scrwd).UsedRange.Rows.Count
    End With
    
    If crhangshu > 0 Then
        With Sheets("生产领料")
            .Activate
            zhongdianhang = .Range("A:A").Find("终点行").Row
            'hangshu2 = .Range("B31311").End(xlUp).Row
            hangshu2 = .Range("A:A").Find("终点行").End(xlUp).Row
            .Rows(hangshu2 + 1).Resize(crhangshu).Insert
            zonghangshu = hangshu2 + crhangshu
            .Range("A" & hangshu2 + 1 & ":A" & zonghangshu).Value = "11月手工补齐"
            Sheets(scrwd).Range("C2:C" & hangshu3).Copy
            .Range("B" & hangshu2 + 1).PasteSpecial Paste:=xlPasteValues
            Sheets(scrwd).Range("M2:O" & hangshu3).Copy
            .Range("G" & hangshu2 + 1).PasteSpecial Paste:=xlPasteValues
            Sheets(scrwd).Range("T2:T" & hangshu3).Copy
            .Range("K" & hangshu2 + 1).PasteSpecial Paste:=xlPasteValues
            Sheets(scrwd).Delete
        End With
    Else
        Sheets(scrwd).Delete
        jsq = jsq - 1
    End If
    hangshu3 = 0
    'MsgBox zonghangshu
 
Next
 
Application.DisplayAlerts = True
 
End Sub