[已解决]修改代码：同一《日期》下保存多个《单位名称》的内容

lufabao

file:///C:\Documents and Settings\Administrator\Application Data\Tencent\Users\497153396\QQ\WinTemp\RichOle\8EDBC]_S]%SRA)0N4QR({V3.png
Sub 每日清单保存()
With Sheets("各店日报表")
Set rng = .Cells(Rows.Count, 1).End(xlUp)
  Set rng1 = .Cells(Rows.Count, 2).End(xlUp)

Set frng = .Columns(1).Find([c4].Value, , , xlWhole)
If frng Is Nothing Then
End If

  Set frng1 = .Columns(2).Find([f4].Value, , , xlWhole)
  If frng1 Is Nothing Then

End If
If frng1 Is Nothing Then
'    ◇◇◇金额保存
    rng.Offset(1, 0) = [c4]
    rng.Offset(1, 1) = [f4]

    rng.Offset(1, 3) = [f6]
    rng.Offset(1, 5) = [f7]
    rng.Offset(1, 7) = [f8]
    rng.Offset(1, 9) = [f9]
    rng.Offset(1, 11) = [f10]
    rng.Offset(1, 13) = [f11]

    rng.Offset(1, 15) = [f12]
    rng.Offset(1, 17) = [f13]
    rng.Offset(1, 19) = [f14]
    rng.Offset(1, 21) = [f15]
    rng.Offset(1, 23) = [f16]
    rng.Offset(1, 25) = [f17]

    rng.Offset(1, 27) = [f18]
    rng.Offset(1, 29) = [f19]
    rng.Offset(1, 31) = [f20]
    rng.Offset(1, 33) = [f21]
    rng.Offset(1, 35) = [f22]
    rng.Offset(1, 36) = [f24]
    rng.Offset(1, 37) = Date '交费时间

'    ◇◇◇件数保存
    rng.Offset(1, 2) = [d6]
    rng.Offset(1, 4) = [d7]
    rng.Offset(1, 6) = [d8]
    rng.Offset(1, 8) = [d9]
    rng.Offset(1, 10) = [d10]
    rng.Offset(1, 12) = [d11]

    rng.Offset(1, 14) = [d12]
    rng.Offset(1, 16) = [d13]
    rng.Offset(1, 18) = [d14]
    rng.Offset(1, 20) = [d15]
    rng.Offset(1, 22) = [d16]
    rng.Offset(1, 24) = [d17]

    rng.Offset(1, 26) = [d18]
    rng.Offset(1, 28) = [d19]
    rng.Offset(1, 30) = [d20]
    rng.Offset(1, 32) = [d21]
    rng.Offset(1, 34) = [d22]

'    MsgBox "保存成功！"
Else
    MsgBox "您已经保存过了！"
End If


End With
End Sub

Sub 每日清单开单()
Union([d6:d21], [d22]) = ""
[c2] = Format(Now, "BJFyyyymmddhhmmss")
End Sub

最佳答案

月排行榜 / 总排行榜

grf1973

2017-6-7 16:46

1. Sub 保存()
   
2.     With Sheets("各店日报表")
   
3.         rmax = .[a65536].End(3).Row
   
4.         For r = 6 To rmax
   
5.             If .Cells(r, 1) = [c4] And .Cells(r, 2) = [f4] Then   '单位+日期是否已存在，判断是新增记录，还是更新记录
   
6.                 yn = MsgBox("您已经保存过了！重新保存？", vbYesNo)
   
7.                 If yn = vbNo Then Exit Sub
   
8.                 Exit For
   
9.             End If
   
10.         Next
    
11.         .Cells(r, 1) = [c4]: .Cells(r, 2) = [f4]   '单位，日期
    
12.         For k = 6 To 22
    
13.             .Cells(r, 2 * k - 9) = Cells(k, 4)  '数量
    
14.             .Cells(r, 2 * k - 9 + 1) = Cells(k, 6)   '金额
    
15.             s = s + Cells(k, 6)
    
16.         Next
    
17.         .Cells(r, 37) = s
    
18.         .Cells(r, 38) = Date '交费时间
    
19.         MsgBox "记录已保存在第" & r & "行！"
    
20.     End With
    
21. End Sub

复制代码

跳转到最佳答案楼层

chart888

附件呢

lufabao

对不起大家了，忘了发附件了，现在补上。http://www.excelpx.com/forum.php?mod=attachment&aid=NDE5NTk0fGE4YzY5YTYwZjFlYTEyNWZiMjI0NGQxYWJiMTk4ODc3fDE3MTQxMjU2MjU%3D&request=yes&_f=.rar 按键保存.rar (26.32 KB, 下载次数: 7)

2017-6-7 16:15 上传

点击文件名下载附件

grf1973

1. Sub 保存()
   
2.     With Sheets("各店日报表")
   
3.         rmax = .[a65536].End(3).Row
   
4.         For r = 6 To rmax
   
5.             If .Cells(r, 1) = [c4] And .Cells(r, 2) = [f4] Then   '单位+日期是否已存在，判断是新增记录，还是更新记录
   
6.                 yn = MsgBox("您已经保存过了！重新保存？", vbYesNo)
   
7.                 If yn = vbNo Then Exit Sub
   
8.                 Exit For
   
9.             End If
   
10.         Next
    
11.         .Cells(r, 1) = [c4]: .Cells(r, 2) = [f4]   '单位，日期
    
12.         For k = 6 To 22
    
13.             .Cells(r, 2 * k - 9) = Cells(k, 4)  '数量
    
14.             .Cells(r, 2 * k - 9 + 1) = Cells(k, 6)   '金额
    
15.             s = s + Cells(k, 6)
    
16.         Next
    
17.         .Cells(r, 37) = s
    
18.         .Cells(r, 38) = Date '交费时间
    
19.         MsgBox "记录已保存在第" & r & "行！"
    
20.     End With
    
21. End Sub

复制代码

lufabao

谢谢老师！我试验过了，好用又明了，再次感谢！

雄鹰2013

学习