[已解决]好好学习，天天向上

229094667

半桶水的我，画不出瓢，敬衣大虾指导

最佳答案

月排行榜 / 总排行榜

liyizhe000

2017-3-22 17:55

答案已上传，请下载查看

跳转到最佳答案楼层

liyizhe000

答案已上传，请下载查看

229094667

liyizhe000 发表于 2017-3-22 17:55
答案已上传，请下载查看

还有两点, 一是同一张单据,付款只记一次;二是可否在点击"存入流水单"时,设置一个"提示确认"

liyizhe000

229094667 发表于 2017-3-22 19:35
还有两点, 一是同一张单据,付款只记一次;二是可否在点击"存入流水单"时,设置一个"提示确认"

Sub 流水单()
Dim arr, k, i, m, n, t
arr = Sheets("送货单").Range("b2:q17")
m = 3
Do Until Sheets("流水单").Range("a" & m) = ""
m = m + 1
Loop
For i = 4 To UBound(arr)
With Sheets("流水单")
If arr(i, 1) <> "" Then
.Cells(m, 1) = arr(2, 8)
.Cells(m, 2) = arr(2, 11)
.Cells(m, 3) = arr(2, 13)
.Cells(m, 4) = arr(1, 2) '客户
.Cells(m, 5) = arr(2, 2) '手机
.Cells(m, 6) = arr(3, 16) '单号
.Cells(m, 7) = arr(i, 1) '名称
.Cells(m, 8) = arr(i, 5) '单位
.Cells(m, 9) = arr(i, 6) '数量
.Cells(m, 10) = arr(i, 8) '吨数
.Cells(m, 11) = arr(i, 10) '单价
.Cells(m, 12) = arr(i, 12) '金额
.Cells(m, 13) = Sheets("送货单").Cells(19, 3) '备注
.Cells(m, 14) = Sheets("送货单").Cells(20, 4) '收货人
.Cells(m, 15) = Sheets("送货单").Cells(20, 8) '制单
.Cells(m, 16) = Sheets("送货单").Cells(20, 12) '送货人
m = m + 1
End If
End With
Next
k = WorksheetFunction.CountA(Sheets("送货单").Range("B5:B17"))
t = Sheets("流水单").[a65536].End(xlUp).Row
n = WorksheetFunction.CountIf(Sheets("流水单").Range("F3:F" & t), Sheets("送货单").Range("Q4"))
If n = k Then
MsgBox "录入完成！"
Else
Sheets("流水单").Range("a" & t - k + 1 & ":" & "a" & t).EntireRow.ClearContents
MsgBox "已重复录入"
End If
End Sub

229094667

liyizhe000 发表于 2017-3-23 10:35
Sub 流水单()
Dim arr, k, i, m, n, t
arr = Sheets("送货单").Range("b2:q17")

.Cells(m, 13) = Sheets("送货单").Cells(19, 3) '备注     一个单叫如何设置只记一次,谢谢

liyizhe000

229094667 发表于 2017-3-23 13:00
.Cells(m, 13) = Sheets("送货单").Cells(19, 3) '备注     一个单叫如何设置只记一次,谢谢

不太懂什么意思！

229094667

liyizhe000 发表于 2017-3-23 16:25
不太懂什么意思！

意思是同一个单号,备注如果已收两万,每个品种规格对应的备注都显示两万,这样合计收了四万,可是实际只收以两万,如图所示,谢谢

liyizhe000

Sub 流水单()
Dim arr, k, i, m, n, t
Application.DisplayAlerts = False
arr = Sheets("送货单").Range("b2:q17")
m = 3
Do Until Sheets("流水单").Range("a" & m) = ""
m = m + 1
Loop
For i = 4 To UBound(arr)
With Sheets("流水单")
If arr(i, 1) <> "" Then
.Cells(m, 1) = arr(2, 8)
.Cells(m, 2) = arr(2, 11)
.Cells(m, 3) = arr(2, 13)
.Cells(m, 4) = arr(1, 2) '客户
.Cells(m, 5) = arr(2, 2) '手机
.Cells(m, 6) = arr(3, 16) '单号
.Cells(m, 7) = arr(i, 1) '名称
.Cells(m, 8) = arr(i, 5) '单位
.Cells(m, 9) = arr(i, 6) '数量
.Cells(m, 10) = arr(i, 8) '吨数
.Cells(m, 11) = arr(i, 10) '单价
.Cells(m, 12) = arr(i, 12) '金额
.Cells(m, 13) = Sheets("送货单").Cells(19, 3) '备注
.Cells(m, 14) = Sheets("送货单").Cells(20, 4) '收货人
.Cells(m, 15) = Sheets("送货单").Cells(20, 8) '制单
.Cells(m, 16) = Sheets("送货单").Cells(20, 12) '送货人
m = m + 1
End If
End With
Next
k = WorksheetFunction.CountA(Sheets("送货单").Range("B5:B17"))
t = Sheets("流水单").[a65536].End(xlUp).Row
n = WorksheetFunction.CountIf(Sheets("流水单").Range("F3:F" & t), Sheets("送货单").Range("Q4"))
Sheets("流水单").Range("m" & m - k & ":" & "m" & t).Merge
If n = k Then
MsgBox "录入完成！"

Else
Sheets("流水单").Range("a" & t - k + 1 & ":" & "a" & t).EntireRow.ClearContents
MsgBox "已重复录入"
End If
Application.DisplayAlerts = True
End Sub