|
|
Sub 入库保存()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
Dim rn As Range
With Sheets("供应商信息汇总")
ws = .Cells(Rows.Count, 1).End(xlUp).Row
If ws > 2 Then
cr = .Range("a2:a" & ws)
For i = 2 To UBound(cr)
If cr(i, 1) <> "" Then
d(cr(i, 1)) = ""
End If
Next i
End If
End With
With Sheets("物料名称表")
ms = .Cells(Rows.Count, 1).End(xlUp).Row
If ms > 2 Then
crr = .Range("a2:d" & ms)
For i = 2 To UBound(crr)
If crr(i, 1) <> "" Then
zd = crr(i, 1) & "|" & crr(i, 2) & "|" & crr(i, 3) & "|" & crr(i, 4)
dc(zd) = ""
End If
Next i
End If
End With
With Sheets("入库单")
r = [c5].End(xlDown).Row
If r = 16 Then MsgBox "入库单为空，请先录入数据！": End
ar = .Range("a1:l16")
xm = .[d2]
If xm = "" Then MsgBox "项目名称为空！": End
jbr = .[i2]
If jbr = "" Then MsgBox "经办人称为空！": End
dw = .[d3]
If dw = "" Then MsgBox "供货单位为空！": End
dh = .[L2]
If dh = "" Then MsgBox "入库单号为空！": End
End With
Dim br()
ReDim br(1 To UBound(ar), 1 To 15)
ReDim arr(1 To UBound(ar), 1 To 4)
For i = 6 To 15
If ar(i, 3) <> "" Then
n = n + 1
br(n, 1) = ar(1, 12)
br(n, 2) = ar(3, 9)
br(n, 3) = ar(3, 9)
br(n, 4) = ar(3, 4)
br(n, 5) = ar(i, 3)
For j = 5 To 12
br(n, j + 1) = ar(i, j)
Next j
br(n, 14) = ar(2, 12)
br(n, 15) = ar(2, 9)
zd = ar(i, 3) & "|" & ar(i, 5) & "|" & ar(i, 6) & "|" & ar(i, 7)
If Not dc.exists(zd) Then
m = m + 1
arr(m, 1) = ar(i, 3)
arr(m, 2) = ar(i, 5)
arr(m, 3) = ar(i, 6)
arr(m, 4) = ar(i, 7)
End If
End If
Next i
If n = "" Then MsgBox "入库单为空，请先录入数据！": End
If Not d.exists(dw) Then Sheets("供应商信息汇总").Cells(ws + 1, 1) = dw
If m <> "" Then Sheets("物料名称表").Cells(ms + 1, 1).Resize(m, 4) = arr
With Sheets("入库流水表")
rs = .Cells(Rows.Count, 1).End(xlUp).Row + 1
Set rn = .Range("n2:n" & rs - 1).Find(dh, , , , , , 1)
If Not rn Is Nothing Then MsgBox "不能重复录入！": End
.Cells(rs, 1).Resize(n, UBound(br, 2)) = br
End With
ww = Val(Right([L2], 4)) + 1
[L2] = "RK" & Format(ww, "0000")
MsgBox "录入完毕！", 64, "提醒！"
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-3-14 08:37
楼主
