请教：从选择的编号起显示的问题

鄂龙蒙

从选择的编号起显示的问题：
想要从被选择的编号中有相同编号的第一个开始显示，试了好长时间，没做好，请大师帮忙，谢谢！

模拟件.rar (27.12 KB, 下载次数: 31)

2014-5-25 18:24 上传

点击文件名下载附件

百度不到去谷歌

你就是要做一个类似高级筛选么  你这也太麻烦了 懒得看bug 用sql吧
给你写个简单的 用sql来做筛选

1.     Dim sql, brr, i&, ITM
   
2.     sql = "select 月,日, 项目,材料名称,单位,数量 from [Sheet1$A4:I] where 编号=" & ComboBox1.Value
   
3.     brr = SqlToArr(sql)
   
4.     UserForm1.ListView1.ListItems.Clear
   
5.         For i = 1 To UBound(brr)
   
6.             '添加记录
   
7.             Set ITM = ListView1.ListItems.Add()
   
8.             '添加内容
   
9.             ITM.Text = brr(i, 1)
   
10.             ITM.SubItems(1) = brr(i, 2)
    
11.             ITM.SubItems(2) = brr(i, 3)
    
12.             ITM.SubItems(3) = brr(i, 4)
    
13.             ITM.SubItems(4) = brr(i, 5)
    
14.             ITM.SubItems(5) = brr(i, 6)
    
15.        Next i
    
16. 
    
17. End Sub
    
18. 
    
19. 
    
20. Private Sub UserForm_Initialize()
    
21.     Dim ITM As ListItem, sql$
    
22.     With ListView1
    
23.         .ColumnHeaders.Add , , "月", .Width / 16, lvwColumnLeft   '居左--第一列只能居左
    
24.         .ColumnHeaders.Add , , "日", .Width / 16, lvwColumnCenter
    
25.         .ColumnHeaders.Add , , "项目名称", .Width / 4, lvwColumnCenter
    
26.         .ColumnHeaders.Add , , "材料名称", .Width / 4, lvwColumnCenter
    
27.         .ColumnHeaders.Add , , "单位", .Width / 9, lvwColumnRight  '居右
    
28.         .ColumnHeaders.Add , , "数量", .Width / 5, lvwColumnRight  '居右
    
29.         .View = lvwReport         '设置显示格式为报表格式
    
30.         .Gridlines = True           '显示网格线
    
31.         .FullRowSelect = True
    
32.      End With
    
33.     sql = "select distinct 编号 from [Sheet1$A4:I] where not 编号 is null "
    
34.     ComboBox1.List = SqlToArr(sql)
    
35. End Sub
    
36. 
    
37. Function SqlToArr(ByVal sql$)    '查询结果到数组
    
38.     Dim cnn As Object    'New ADODB.Connection
    
39.     Dim rs As Object, arr   'New ADODB.Recordset
    
40.     Set cnn = CreateObject("adodb.connection")
    
41.     cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties =Excel 12.0;Data Source =" & ThisWorkbook.FullName
    
42.     'On Error Resume Next
    
43.     Set rs = cnn.Execute(sql)
    
44.     SqlToArr = Application.Transpose(rs.GetRows) '转置为excle格式的行列
    
45.     'Set cnn = Nothing: Set rs = Nothing
    
46. End Function

复制代码

11模拟件.rar (26.92 KB, 下载次数: 56)

2014-5-26 12:07 上传

点击文件名下载附件

鄂龙蒙

百度不到去谷歌 发表于 2014-5-26 12:07
你就是要做一个类似高级筛选么  你这也太麻烦了 懒得看bug 用sql吧
给你写个简单的 用sql来做筛选

谢谢您大师帮助！

我想从选择的那个号（包括选取的号）开始，向下全部显示。怎么处理？谢谢！

百度不到去谷歌

鄂龙蒙 发表于 2014-5-26 13:02
谢谢您大师帮助！

我想从选择的那个号（包括选取的号）开始，向下全部显示。怎么处理？谢谢！

sql里=改成>=  sql = "select 月,日, 项目,材料名称,单位,数量 from [Sheet1$A4:I] where 编号>=" & ComboBox1.Value

鄂龙蒙

谢谢！非常好！

鄂龙蒙

在下面加一行合计怎么加？谢谢！

鄂龙蒙

百度不到去谷歌 发表于 2014-5-26 12:07
你就是要做一个类似高级筛选么  你这也太麻烦了 懒得看bug 用sql吧
给你写个简单的 用sql来做筛选

在下面加一行合计怎么加？谢谢！

VBA万岁

鄂龙蒙 发表于 2014-5-26 15:05
在下面加一行合计怎么加？谢谢！

加上如下代码即可：
    c = c + Val(brr(i, 6))
    Next i
    Set ITM = ListView1.ListItems.Add()
    ITM.Text = "汇总"
    ITM.SubItems(5) = c

VBA万岁

VBA万岁 发表于 2014-5-26 15:37
加上如下代码即可：
    c = c + Val(brr(i, 6))
    Next i

即：
Option Explicit

Private Sub ComboBox1_Change()
    Dim sql, brr, i&, c As Long, ITM
    sql = "select 月,日, 项目,材料名称,单位,数量 from [Sheet1$A4:I] where 编号=" & ComboBox1.Value
    brr = SqlToArr(sql)
    UserForm1.ListView1.ListItems.Clear
    For i = 1 To UBound(brr)
        '添加记录
        Set ITM = ListView1.ListItems.Add()
        '添加内容
        ITM.Text = brr(i, 1)
        ITM.SubItems(1) = brr(i, 2)
        ITM.SubItems(2) = brr(i, 3)
        ITM.SubItems(3) = brr(i, 4)
        ITM.SubItems(4) = brr(i, 5)
        ITM.SubItems(5) = brr(i, 6)
        c = c + Val(brr(i, 6))    Next i
    Set ITM = ListView1.ListItems.Add()
    ITM.Text = "汇总"
    ITM.SubItems(5) = cEnd Sub

Private Sub UserForm_Initialize()
    Dim ITM As ListItem, sql$
    With ListView1
        .ColumnHeaders.Add , , "月", .Width / 16, lvwColumnLeft   '居左--第一列只能居左
        .ColumnHeaders.Add , , "日", .Width / 16, lvwColumnCenter
        .ColumnHeaders.Add , , "项目名称", .Width / 4, lvwColumnCenter
        .ColumnHeaders.Add , , "材料名称", .Width / 4, lvwColumnCenter
        .ColumnHeaders.Add , , "单位", .Width / 9, lvwColumnRight  '居右
        .ColumnHeaders.Add , , "数量", .Width / 5, lvwColumnRight  '居右
        .View = lvwReport         '设置显示格式为报表格式
        .Gridlines = True           '显示网格线
        .FullRowSelect = True
    End With
    sql = "select distinct 编号 from [Sheet1$A4:I] where not 编号 is null "
    ComboBox1.List = SqlToArr(sql)
End Sub

Function SqlToArr(ByVal sql$)    '查询结果到数组
    Dim cnn As Object    'New ADODB.Connection
    Dim rs As Object, arr   'New ADODB.Recordset
    Set cnn = CreateObject("adodb.connection")
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties =Excel 12.0;Data Source =" & ThisWorkbook.FullName
    'On Error Resume Next
    Set rs = cnn.Execute(sql)
    SqlToArr = Application.Transpose(rs.GetRows) '转置为excle格式的行列
    'Set cnn = Nothing: Set rs = Nothing
End Function

VBA万岁

VBA万岁 发表于 2014-5-26 15:38
即：
Option Explicit

附件：
1模拟件.rar (25.7 KB, 下载次数: 46)

2014-5-26 15:39 上传

点击文件名下载附件