[已解决]求一个查询代码

lufabao

这个帖子我几天前发过，是grf1973大师给做的。现在是求查询代码，如果能把下面的代码修改成查询代码更好。恳请大师帮忙，谢谢！
Sub 保存()With Sheets("各店日报表")
    If [c4] = "" Then MsgBox "《单位名称》不能为空！": Exit Sub
    If [f4] = "" Then MsgBox "《日期》不能为空！": Exit Sub
    If [d23] = "" Then MsgBox "《请输入内容》！不能为空！": Exit Sub
    rmax = .[a65536].End(3).Row
    For r = 6 To rmax
        If .Cells(r, 1) = [c4] And .Cells(r, 2) = [f4] Then
            yn = MsgBox("您已经保存过了！重新保存等于修改？", vbYesNo)
            If yn = vbNo Then Exit Sub
            Exit For
        End If
    Next
    .Cells(r, 1) = [c4]: .Cells(r, 2) = [f4]
    For K = 6 To 22
        .Cells(r, 3 * K - 15) = Cells(K, 4)
        .Cells(r, 3 * K - 15 + 1) = Cells(K, 6)
         .Cells(r, 3 * K - 14 + 1) = Cells(K, 7)
        s = s + Cells(K, 6)
    Next
    .Cells(r, 54) = s
    .Cells(r, 55) = Date
    MsgBox "记录已保存在第" & r & "行！"
End With
End Sub

最佳答案

月排行榜 / 总排行榜

grf1973

2017-6-21 15:46

1. Sub 查询()
   
2.     With Sheets("各店日报表")
   
3.         If [c4] = "" Then MsgBox "《单位名称》不能为空！": Exit Sub
   
4.         If [f4] = "" Then MsgBox "《日期》不能为空！": Exit Sub
   
5.         rmax = .[a65536].End(3).Row
   
6.         For r = 6 To rmax
   
7.             If .Cells(r, 1) = [c4] And .Cells(r, 2) = [f4] Then Exit For
   
8.         Next
   
9.         If r <= rmax Then
   
10.             For K = 6 To 22
    
11.                 Cells(K, 4) = .Cells(r, 3 * K - 15)
    
12.                 Cells(K, 6) = .Cells(r, 3 * K - 15 + 1)
    
13.                 Cells(K, 7) = .Cells(r, 3 * K - 14 + 1)
    
14.             Next
    
15.         Else
    
16.             MsgBox "未找到匹配记录"
    
17.         End If
    
18.     End With
    
19. End Sub
    

复制代码

跳转到最佳答案楼层

lufabao

还没有遇到高人，再提提，希望高人能给帮忙，谢谢！

lufabao

又两天过去了，帖子沉底了，再提提希望高人能看到。

lufabao

有那位高手给帮帮忙，谢谢了。

grf1973

1. Sub 查询()
   
2.     With Sheets("各店日报表")
   
3.         If [c4] = "" Then MsgBox "《单位名称》不能为空！": Exit Sub
   
4.         If [f4] = "" Then MsgBox "《日期》不能为空！": Exit Sub
   
5.         rmax = .[a65536].End(3).Row
   
6.         For r = 6 To rmax
   
7.             If .Cells(r, 1) = [c4] And .Cells(r, 2) = [f4] Then Exit For
   
8.         Next
   
9.         If r <= rmax Then
   
10.             For K = 6 To 22
    
11.                 Cells(K, 4) = .Cells(r, 3 * K - 15)
    
12.                 Cells(K, 6) = .Cells(r, 3 * K - 15 + 1)
    
13.                 Cells(K, 7) = .Cells(r, 3 * K - 14 + 1)
    
14.             Next
    
15.         Else
    
16.             MsgBox "未找到匹配记录"
    
17.         End If
    
18.     End With
    
19. End Sub
    

复制代码

lufabao

grf1973 发表于 2017-6-21 15:46

grf1973l老师您好，我的几个问题都是您给解决的，十分感谢，没什么可说的，祝你身体健康万事如意！