Sub C_出库清空()
Application.ScreenUpdating = False
With Sheet3
.Range("C3") = ""
.Range("C4") = ""
.Range("F4") = ""
.Range("H4") = ""
.Range("B7:G56").ClearContents
.Range("I7:I56").ClearContents
.Range("G3") = ""
.Range("I59") = ""
.Range("K1") = Format(DateAdd("d", 1, Date))
.Range("F3") = "=text(K1,""yyyy-m-d"")"
.Range("H3") = "=" & Sheet13.Name & "!$C$13&" & Sheet13.Name & "!$C$16&TEXT(K1," & Sheet13.Name & "!$C$14)&" & Sheet13.Name & "!$C$16&TEXT(K2," & Sheet13.Name & "!$C$15)"
' .Rows("16:55").Hidden = True
.Range("X1") = ""
.Range("Z1") = ""
.Range("H57") = "=Sum(H7:H56)" 'Application.WorksheetFunction.Sum(Range("H6:H55"))
'.Range("H7:H56").FormulaR1C1 = "=ROUNDDOWN(RC[-2]*RC[-1],1)"
End With
'Updateby Extendoffice 20161008
Range("M1").ClearContents
'点击出库查询清除L6单元格内容
Call ShowLine
Application.ScreenUpdating = False
End Sub
Sub C_出库保存()
a = Sheet3.Range("C3") '供应商
b = Format(Sheet3.Range("F3"), "yyyy-m-d") '日期
tembh = Sheet3.Range("H3") '单号
d1 = Application.WorksheetFunction.CountA(Sheet3.Range("B7:B57")) '产品数据行数
d2 = Application.WorksheetFunction.CountA(Sheet3.Range("F7:F57")) '产品数量行
'd3 = Application.WorksheetFunction.CountIf(Sheet4.Range("D:D"), tembh) '是否存在相同单号
If a = "" Then
MsgBox "请输入购货单位及相关信息!", 64, "保存提示"
Exit Sub
End If
If b = "" Then
MsgBox "请输入销售日期!", 64, "保存提示"
Exit Sub
End If
If tembh = "" Then
MsgBox "请输入单号!", 64, "保存提示"
Exit Sub
End If
'**********************************************************
Dim k, n, o As Long
n = Sheet4.Range("A" & Sheet4.Rows.Count).End(xlUp).Row
Dim brr
brr = Sheet4.Range("B1:D" & n)
For o = 1 To n
If tembh = UCase(Trim(CStr(brr(o, 3)))) And CStr(brr(o, 1)) = "出库" Then
Dim ms
ms = MsgBox("已经存在 " & Trim(CStr(Range("H3").Value)) & " 的单据号码，是否覆盖以前的数据？" & vbCrLf & vbCrLf & "点击“是”覆盖以前的数据；点击“否”取消本次保存操作。", vbYesNo + vbInformation, "提示")
If ms = vbNo Then
Exit Sub
Else
Call ChuKuDan_DelRs(False)
Exit For
End If
End If
Next
If d1 = d2 And d1 = 0 And d2 = 0 Then
MsgBox "没有数据可以保存,请输入数据后再点击保存数据！", 64, "保存提示"
Exit Sub
End If
If d1 <> d2 Then
MsgBox "请检查商品名称及数量是否已对应输入,请输入或清除多余数据后保存!", 64, "保存提示"
Exit Sub
End If
E = Application.CountIf(Sheet8.Range("B:B"), Sheet3.Range("C3") & "")
'客户编号 客户名称 联系地址 联系电话 联系人
If E < 1 Then
x = MsgBox("此购货单位信息为新信息,是否保存到客户信息中？点“是”将保存，否则跳过！", vbYesNo)
If x = vbYes Then '添加供应商信息到基本信息中
e1 = Sheet8.Range("B" & Rows.Count).End(xlUp).Row + 1
Sheet8.Range("A" & e1) = "C" & Format(e1 - 2, "0000")
Sheet8.Range("B" & e1) = "'" & a
Sheet3.Range("X1") = "'" & Sheet8.Range("A" & e1) '编号
Sheet8.Range("C" & e1) = "'" & Sheet3.Range("C4")
Sheet8.Range("D" & e1) = "'" & Sheet3.Range("F4")
Sheet8.Range("E" & e1) = "'" & Sheet3.Range("H4")
End If
End If
Dim arr()
xi = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
ReDim arr(1 To xi)
For xj = 1 To xi
arr(xj) = Sheet1.Range("A" & xj)
Next
s = 0
For j = 7 To 56
If Sheet3.Range("B" & j) <> "" Then
For j1 = 1 To UBound(arr)
If Sheet3.Range("B" & j) = arr(j1) Then
s = 1
Exit For
End If
Next
If s = 0 Then
MsgBox "行号：" & j & "名称：" & Sheet3.Range("C" & j) & " 品牌及型号：" & Sheet3.Range("D" & j) & "记录非窗体选择，请双击录入", vbInformation, "消息提示"
Exit Sub
' bc = MsgBox("基本信息表没有此信息，行号：" & j & "名称：" & Sheet3.Range("B" & j) & " 品牌及型号：" & Sheet3.Range("D" & j) & " ，是否需要将此信息新增至基本信息表？", vbYesNo, "保存提示!")
' If bc = vbYes Then
' h = Sheet1.Range("B" & Rows.Count).End(xlUp).Row + 1
' Sheet1.Range("A" & h) = "C" & Format(h - 2, "0000")
' Sheet3.Range("X" & j) = "'" & Sheet1.Range("A" & h)
' Sheet1.Range("B" & h) = "'" & Sheet3.Range("B" & j)
' Sheet1.Range("C" & h) = "'" & Sheet3.Range("D" & j)
' Sheet1.Range("D" & h) = "'" & Sheet3.Range("E" & j)
' Else
' Exit Sub
' End If
' ElseIf s > 0 And Sheet3.Range("X" & j) = "" Then
' MsgBox "行号：" & j & "名称：" & Sheet3.Range("B" & j) & " 品牌及型号：" & Sheet3.Range("D" & j) & "记录非窗体选择，请双击录入", vbInformation, "消息提示"
' Exit Sub
' 'Sheet3.Range("X" & j) = Sheet1.Range("A" & Application.WorksheetFunction.Match(Sheet3.Range("B" & j) & Sheet3.Range("D" & j), arr, 0) + 2)
End If
'
' s = 0
End If
Next
Application.ScreenUpdating = False
'If Sheet3.Range("Z1") = "A" Then
'
'Call ChuKuDan_DelRs(False)
'
'
'
'End If
Sheet3.Select
If Sheet4.AutoFilterMode = True Then Sheet4.Range("A1").AutoFilter
With Sheet3
jsz = 0
For i = 7 To 56
If .Range("B" & i) <> "" Then
f1 = Sheet4.Range("B" & Rows.Count).End(xlUp).Row + 1
Sheet4.Range("A" & f1) = "=row()-1" '行号
Sheet4.Range("B" & f1) = "出库" '单据类型"
Sheet4.Range("C" & f1) = Format(b, "yyyy-m-d") '日期
Sheet4.Range("D" & f1) = "'" & tembh '单号
Sheet4.Range("E" & f1) = "'" & .Range("X1") '单位编号
Sheet4.Range("F" & f1) = "'" & a '往来单位
Sheet4.Range("G" & f1) = "'" & .Range("C4") '地址
Sheet4.Range("H" & f1) = "'" & .Range("F4") '电话
Sheet4.Range("I" & f1) = "'" & .Range("H4") '联系人
Sheet4.Range("R" & f1) = "'" & .Range("G3") '备注
Sheet4.Range("S" & f1) = "'" & .Range("I59") '制单人
Sheet4.Range("J" & f1) = "'" & .Range("B" & i) '商品编号
Sheet4.Range("K" & f1) = "'" & .Range("C" & i) '名称
Sheet4.Range("L" & f1) = "'" & .Range("D" & i) '品牌及型号
Sheet4.Range("M" & f1) = "'" & .Range("E" & i) '单位
Sheet4.Range("N" & f1) = .Range("F" & i) '数量
Sheet4.Range("O" & f1) = .Range("G" & i) '单价
Sheet4.Range("P" & f1) = .Range("H" & i) '金额
Sheet4.Range("Q" & f1) = .Range("I" & i) '明细备注
End If
Next
If .Range("Z1") <> "A" Then
h = Sheet3.Range("K2").Value
Sheet3.Range("K2").Value = h + 1
End If
评论3