[已解决]从工作簿中查询取数

心灵之舞

查询取数.rar (67.64 KB, 下载次数: 16)

2014-4-25 09:55 上传

点击文件名下载附件

1、从弹出窗体中选择复选框，点查询，自动从比赛文件的汇总表和代表队信息表中查询数据汇总到查询的表一上面。

2、查询弹出窗体中的复选框内容是获取的比赛文件汇总表中的列D中获取。

3、项目取数是从项目1和项目2加起来，如项目2中有数，则中间用/隔开。

4、A2的内容为选择复选框内容。

谢谢论坛里的高人帮助解答。

最佳答案

月排行榜 / 总排行榜

grf1973

2014-4-25 14:49

1. Dim arr, brr, d
   
2. Private Sub CommandButton1_Click()   '查询
   
3.     Set d1 = CreateObject("scripting.dictionary")
   
4.     dbd = Me.ComboBox1   '代表队
   
5.     With Sheet1
   
6.         .[a2] = dbd
   
7.         .Range("b3:b5,d3:d5,f3:f5,a7:f1000") = ""
   
8.         For i = 2 To UBound(brr)
   
9.             If dbd = Trim(brr(i, 2)) Then
   
10.                 ld = Trim(brr(i, 3))
    
11.                 jl = Trim(brr(i, 5))
    
12.                 .[b3] = ld: .[b4] = jl    '领队、教练
    
13.                 .[d3] = brr(i, 4): .[d4] = brr(i, 6)   '电话
    
14.                 If Len(ld) > 0 Then .[f3] = UBound(Split(ld, " ")) + 1
    
15.                 If Len(jl) > 0 Then .[f4] = UBound(Split(jl, " ")) + 1 '人数
    
16.                 .[b5] = brr(i, 7)
    
17.             End If
    
18.         Next
    
19.                
    
20.         ReDim crr(1 To 1000, 1 To 6)
    
21.         For i = 2 To UBound(arr)
    
22.             If dbd = Trim(arr(i, 4)) Then
    
23.                 male = Trim(arr(i, 2)): female = Trim(arr(i, 3))
    
24.                 x = male & " " & female  '男+女,计算总人数用
    
25.                 n = n + 1
    
26.                 crr(n, 1) = n   '序号
    
27.                 crr(n, 2) = male: crr(n, 3) = female
    
28.                 crr(n, 4) = arr(i, 5)
    
29.                 xm = Trim(arr(i, 6)) & "," & Trim(arr(i, 7))  '项目
    
30.                 If Right(xm, 1) = "," Then xm = Left(xm, Len(xm) - 1)
    
31.                 crr(n, 5) = xm
    
32.                 xrr = Split(x, " ")   '计算总人数
    
33.                 For j = 0 To UBound(xrr)
    
34.                     xkey = Trim(xrr(j))
    
35.                     If Len(xkey) > 0 Then d1(xkey) = ""
    
36.                 Next
    
37.             End If
    
38.         Next
    
39.         .[f5] = d1.Count   '选手人数
    
40.         .[a7].Resize(n, 6) = crr
    
41.     End With
    
42. End Sub
    
43. 
    
44. Private Sub CommandButton2_Click()   '退出
    
45.     Unload Me
    
46. End Sub
    
47. 
    
48. Private Sub UserForm_Initialize()   '初始化
    
49.     Set wb = Workbooks.Open(ThisWorkbook.Path & "\比赛文件.xls")
    
50.     Set d = CreateObject("scripting.dictionary")
    
51.     arr = wb.Sheets(1).[a1].CurrentRegion
    
52.     brr = wb.Sheets(2).[a1].CurrentRegion
    
53.     wb.Close False
    
54.     For i = 2 To UBound(arr)
    
55.         xkey = Trim(arr(i, 4))
    
56.         d(xkey) = d(xkey) + 1
    
57.     Next
    
58.     Me.ComboBox1.List = Application.Transpose(d.keys)
    
59. End Sub

复制代码

跳转到最佳答案楼层

grf1973

1. Dim arr, brr, d
   
2. Private Sub CommandButton1_Click()   '查询
   
3.     Set d1 = CreateObject("scripting.dictionary")
   
4.     dbd = Me.ComboBox1   '代表队
   
5.     With Sheet1
   
6.         .[a2] = dbd
   
7.         .Range("b3:b5,d3:d5,f3:f5,a7:f1000") = ""
   
8.         For i = 2 To UBound(brr)
   
9.             If dbd = Trim(brr(i, 2)) Then
   
10.                 ld = Trim(brr(i, 3))
    
11.                 jl = Trim(brr(i, 5))
    
12.                 .[b3] = ld: .[b4] = jl    '领队、教练
    
13.                 .[d3] = brr(i, 4): .[d4] = brr(i, 6)   '电话
    
14.                 If Len(ld) > 0 Then .[f3] = UBound(Split(ld, " ")) + 1
    
15.                 If Len(jl) > 0 Then .[f4] = UBound(Split(jl, " ")) + 1 '人数
    
16.                 .[b5] = brr(i, 7)
    
17.             End If
    
18.         Next
    
19.                
    
20.         ReDim crr(1 To 1000, 1 To 6)
    
21.         For i = 2 To UBound(arr)
    
22.             If dbd = Trim(arr(i, 4)) Then
    
23.                 male = Trim(arr(i, 2)): female = Trim(arr(i, 3))
    
24.                 x = male & " " & female  '男+女,计算总人数用
    
25.                 n = n + 1
    
26.                 crr(n, 1) = n   '序号
    
27.                 crr(n, 2) = male: crr(n, 3) = female
    
28.                 crr(n, 4) = arr(i, 5)
    
29.                 xm = Trim(arr(i, 6)) & "," & Trim(arr(i, 7))  '项目
    
30.                 If Right(xm, 1) = "," Then xm = Left(xm, Len(xm) - 1)
    
31.                 crr(n, 5) = xm
    
32.                 xrr = Split(x, " ")   '计算总人数
    
33.                 For j = 0 To UBound(xrr)
    
34.                     xkey = Trim(xrr(j))
    
35.                     If Len(xkey) > 0 Then d1(xkey) = ""
    
36.                 Next
    
37.             End If
    
38.         Next
    
39.         .[f5] = d1.Count   '选手人数
    
40.         .[a7].Resize(n, 6) = crr
    
41.     End With
    
42. End Sub
    
43. 
    
44. Private Sub CommandButton2_Click()   '退出
    
45.     Unload Me
    
46. End Sub
    
47. 
    
48. Private Sub UserForm_Initialize()   '初始化
    
49.     Set wb = Workbooks.Open(ThisWorkbook.Path & "\比赛文件.xls")
    
50.     Set d = CreateObject("scripting.dictionary")
    
51.     arr = wb.Sheets(1).[a1].CurrentRegion
    
52.     brr = wb.Sheets(2).[a1].CurrentRegion
    
53.     wb.Close False
    
54.     For i = 2 To UBound(arr)
    
55.         xkey = Trim(arr(i, 4))
    
56.         d(xkey) = d(xkey) + 1
    
57.     Next
    
58.     Me.ComboBox1.List = Application.Transpose(d.keys)
    
59. End Sub

复制代码

grf1973

请看附件。

grf1973

代码29、30把 "," 改成 "/"
xm = Trim(arr(i, 6)) & "/" & Trim(arr(i, 7))  '项目

If Right(xm, 1) = "/" Then xm = Left(xm, Len(xm) - 1)

心灵之舞

感谢楼上的朋友的帮忙,您所做的正是我想要的结果!谢谢了!!!