[已解决]点菜及结算表

yueyiggjjddmm

1.菜点好后 点击（存入）按钮将数据保存到 记录表里 同时编号（B3）+1
2. H3为下拉菜单（下拉内容是未结算的编号，就是记录表里状态栏显示未结算对应的编号）
3.G5:K14根据H3选择的编号显示对应内容
4.点击结算后 在记录表里的状态栏（H列）显示已结算
注：就是只要是已结算的编号H3下拉就不要有已结算的编号
望老师辛苦帮忙弄下，最好帮忙在代码后面注释、以便我学习，谢谢老师
面馆记录.rar (27.92 KB, 下载次数: 26)

2014-5-9 16:39 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

dsmch

2014-5-9 19:50

………………

跳转到最佳答案楼层

xueyingbo

看看。。。
{:1012:}

xueyingbo

看了看，好像无法存入，找不到宏

dsmch

1. Dim p$
   
2. Sub 存入()
   
3. Dim arr, brr, i&, j%
   
4. arr = Range("a1").CurrentRegion
   
5. ReDim brr(1 To UBound(arr) - 4, 1 To 8)
   
6. p = p & "," & [b3]
   
7. For i = 5 To UBound(arr)
   
8.     brr(i - 4, 1) = arr(3, 5)
   
9.     brr(i - 4, 2) = arr(3, 2)
   
10.     For j = 1 To UBound(arr, 2)
    
11.         brr(i - 4, j + 2) = arr(i, j)
    
12.     Next
    
13.     brr(i - 4, 8) = "未结算"
    
14. Next
    
15. With Sheets("记录")
    
16.     n = .Range("a65536").End(xlUp).Row + 1
    
17.     .Cells(n, 1).Resize(UBound(brr), 8) = brr
    
18. End With
    
19. [b3] = [b3] + 1
    
20. Range("a5:e100").ClearContents
    
21. With Range("H3").Validation
    
22.     .Delete
    
23.     .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    
24.     xlBetween, Formula1:=Mid(p, 2)
    
25. End With
    
26. End Sub
    

复制代码

dsmch

1. Sub 结算()
   
2. Dim arr, brr(1 To 1000, 1 To 5), d, i&, s&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. bh = [h3] '编号
   
5. arr = Sheets("记录").Range("a1").CurrentRegion
   
6. Range("g5:k100").ClearContents
   
7. For i = 2 To UBound(arr)
   
8.     If arr(i, 2) = bh Then
   
9.         s = s + 1
   
10.         For j = 3 To 7
    
11.             brr(s, j - 2) = arr(i, j)
    
12.         Next
    
13.         arr(i, 8) = "已结算"
    
14.     Else
    
15.         If Not d.exists(arr(i, 2)) Then d(arr(i, 2)) = arr(i, 2) Else d(arr(i, 2)) = d(arr(i, 2)) & "," & arr(i, 2)
    
16.     End If
    
17. Next
    
18. Range("g5").Resize(s, 5) = brr
    
19. Sheets("记录").Range("a1").CurrentRegion = arr
    
20. With Range("H3").Validation
    
21.     .Delete
    
22.     .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    
23.     xlBetween, Formula1:=Join(d.keys, ",")
    
24. End With
    
25. End Sub
    

复制代码

dsmch

………………

yueyiggjjddmm

谢谢老师了，真的太好了，老师能不能麻烦你再帮我优化下，结算-选择编号后 自动显示清单-点击结算 然后记录里记录“已结算” 最后在 录入表 结算清单 清除显示的内容？

yueyiggjjddmm

老师 还有最好结算后H3下拉就不要显示已结算的编号，能否实现不

Zipall

面馆记录.rar (34.63 KB, 下载次数: 37)

2014-5-9 21:02 上传

点击文件名下载附件
记得请我吃biangbiang面{:3812:}

dsmch

1. Sub 结算()
   
2. On Error Resume Next
   
3. Dim arr, brr(1 To 1000, 1 To 5), d, i&, s&, rng As Range
   
4. Set d = CreateObject("scripting.dictionary")
   
5. bh = [h3] '编号
   
6. Range("g5:k100").ClearContents
   
7. With Sheets("记录")
   
8. arr = .Range("a1").CurrentRegion
   
9. For i = 2 To UBound(arr)
   
10.     If arr(i, 2) = bh Then
    
11.         s = s + 1
    
12.         For j = 3 To 7
    
13.             brr(s, j - 2) = arr(i, j)
    
14.         Next
    
15.         If rng Is Nothing Then Set rng = .Cells(i, 2) Else Set rng = Union(rng, .Cells(i, 2))
    
16.     Else
    
17.         If Not d.exists(arr(i, 2)) Then d(arr(i, 2)) = arr(i, 2) Else d(arr(i, 2)) = d(arr(i, 2)) & "," & arr(i, 2)
    
18.     End If
    
19. Next
    
20. rng.EntireRow.Delete
    
21. End With
    
22. Range("g5").Resize(s, 5) = brr
    
23. With Range("H3").Validation
    
24.     .Delete
    
25.     .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    
26.     xlBetween, Formula1:=Join(d.keys, ",")
    
27. End With
    
28. End Sub
    

复制代码