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
hangshu1 = 74
pds = 0
For i = 3 To hangshu1
scrwd = Sheets("当月入库成本核算202209").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
'crhangshu = Selection.Count - 1
'hangshu3 = Selection.Count
'筛选出来的可见单元格区域的个数
'kuaishu = kjdyg.Areas.Count
'MsgBox kuaishu
' For j = 1 To kuaishu
' '筛选出来总行数,包含表头
' hangshu3 = hangshu3 + kjdyg.Areas(j).Rows.Count
' Next
'需插入的行数
'crhangshu = hangshu3 - 1
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
hangshu2 = .Range("B31311").End(xlUp).Row
.Rows(hangshu2 + 1).Resize(crhangshu).Insert
zonghangshu = hangshu2 + crhangshu
.Range("A" & hangshu2 + 1 & ":A" & zonghangshu).Value = "9月手工补齐"
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
'Sheets.Add after:=Sheets("当月入库成本核算202209")
'ActiveSheet.Name = "手工补齐单号"
'With Sheets("手工补齐单号")
' .Range("A1") = "手工补齐单号"
' For k = 2 To jsq + 1
' .Range("A" & k) = Sheets(5 + k - 1).Name
' Next
'End With
'Sheets("生产领料").Activate
'For m = 2 To zonghangshu
' For n = 3 To hangshu1
' If Sheets("生产领料").Range("B" & m) = Sheets("当月入库成本核算202209").Range("A" & n) Then
' Sheets("生产领料").Range("N" & m) = "202209月工单"
' End If
' Next
'Next
'把9月工单放到一个表中
'Sheets.Add after:=Sheets("当月入库成本核算202209")
'ActiveSheet.Name = "9月工单"
'With Sheets("生产领料").Range("A1:N" & zonghangshu)
' .AutoFilter
' .AutoFilter field:=14, Criteria1:="202209月工单"
' Set kjdyg2 = Sheets("生产领料").AutoFilter.Range.SpecialCells(xlCellTypeVisible)
' Sheets("9月工单").Activate
' kjdyg2.Copy Sheets("9月工单").Range("A1")
'End With
'
'hangshu4 = Sheets("9月工单").Range("G10000").End(xlUp).Row
'ReDim arr(1 To hangshu4, 1 To 2)
'ReDim brr(1 To hangshu4, 1 To 2)
'For a = 2 To hangshu4
' arr(a - 1, 1) = Range("G" & a)
' arr(a - 1, 2) = Range("L" & a)
' brr(a - 1, 1) = Range("G" & a)
' brr(a - 1, 2) = Range("L" & a)
'Next
'
'For a1 = 1 To UBound(arr, 1)
' For b1 = 1 To UBound(brr, 1)
' If arr(a1, 1) = brr(b1, 1) And arr(a1, 2) <> brr(b1, 2) Then
' Sheets("9月工单").Range("O" & a1 + 1) = "单价不一致"
' End If
' Next
'Next
'Sheets("9月工单").Range("A1").Select
'Sheets("9月工单").Range("A2").Select
'ActiveWindow.FreezePanes = True
'Sheets("9月工单").Range("A1").CurrentRegion.AutoFilter
Application.DisplayAlerts = True
End Sub
成本计算表
于 2022-10-27 14:20:15 首次发布