分享: 利用listview制作模糊查询窗体 - 更新

johnny05

目前这个支持 商品代码,商品名称, 分类的模糊查询

coby001

这个 ListView 怎么用啊，在我的控件箱里找不到它，也没有帮助和说明

johnny05

在工具箱引用控件

coby001

我觉得还不如 ListBOx 呢，ListBox 有 List 属性，直接可以整个数组装进去，快捷省事

好像ListView  没有类似的特点吧

薄才多学

太好了，谢谢您！向您学习。

薄才多学

分类的查询好像不准确，麻烦楼主检查一下。

westmood

真的很好!!!

km_gdd

谢谢johnny05 老师，更新的查询对我这种不懂VBA的来说方便多了。

害虫

Private Sub TextBox1_Change()
Dim what As String: what = TextBox1.Value
Dim rw As String: rw = Sheet1.Range("G65536").End(xlUp).Row
Dim total As String
total = 0

If TextBox1.Value = "" Then
    '   如果文本框内容为空,导入所有数据
    ListView1.ListItems.Clear
        With Sheet2
          For i = 4 To rw
            Set ITM = ListView1.ListItems.Add()
            ITM.Text = Cells(i, 7)
            ITM.SubItems(1) = Cells(i, 8)
            ITM.SubItems(2) = Cells(i, 12)
            ITM.SubItems(3) = Cells(i, 13)
            ITM.SubItems(4) = Cells(i, 14)
            ITM.SubItems(5) = Cells(i, 15)
            ITM.SubItems(6) = Cells(i, 16)
            ITM.SubItems(7) = Cells(i, 17)
            ITM.SubItems(8) = Cells(i, 18)
            Next i
        End With
            Label2.Caption = "共找到 " & ListView1.ListItems.Count & " 条记录"
            TextBox1.SetFocus
    Exit Sub

Else

    Dim rng As Range
    Set rng = Sheet2.Range("M4:N" & rw)     '   关键字所在的区域
    Dim dic As Object
    Set dic = CreateObject("scripting.dictionary")
    ListView1.ListItems.Clear   '   清除所有内容
    For i = 4 To rw
        For ii = 1 To 13
            Dim tmp As Range
            Set tmp = Sheet2.Cells(i, ii).Find(what, lookat:=xlPart, MatchCase:=False)      '   部分匹配, 不区分大小写
                If Not tmp Is Nothing Then
                    If Not dic.exists(tmp.Row) Then     '   因为是一行多列查找,所以只要有一个单元格符合要求,要需要换行,否则listitem数据重复
                        dic.Add tmp.Row, ""
                        Set ITM = ListView1.ListItems.Add()
                        ITM.Text = Sheet2.Cells(i, 7)
                        ITM.SubItems(1) = Sheet2.Cells(i, 8)
                        ITM.SubItems(2) = Sheet2.Cells(i, 12)
                        ITM.SubItems(3) = Sheet2.Cells(i, 13)
                        ITM.SubItems(4) = Sheet2.Cells(i, 14)
                        ITM.SubItems(5) = Sheet2.Cells(i, 15)
                        ITM.SubItems(6) = Sheet2.Cells(i, 16)
                        ITM.SubItems(7) = Sheet2.Cells(i, 17)
                        ITM.SubItems(8) = Sheet2.Cells(i, 18)
                    End If
                End If
            Next ii
        Next i
        Label2.Caption = "共找到 " & ListView1.ListItems.Count & " 条记录"
        Set dic = Nothing
End If

End Sub

Private Sub UserForm_Initialize()
  ListView1.ColumnHeaders.Add , , "收料日期", Width / 12.5
  ListView1.ColumnHeaders.Add , , "送货单位", Width / 6
  ListView1.ColumnHeaders.Add , , "材料编号", Width / 11
  ListView1.ColumnHeaders.Add , , "材料名称", Width / 5.25
  ListView1.ColumnHeaders.Add , , "规格型号", Width / 6
  ListView1.ColumnHeaders.Add , , "单位", Width / 22, lvwColumnCenter
  ListView1.ColumnHeaders.Add , , "数量", Width / 16.15, lvwColumnCenter
  ListView1.ColumnHeaders.Add , , "单价", Width / 13, lvwColumnCenter
  ListView1.ColumnHeaders.Add , , "审核情况", Width / 13, lvwColumnCenter
  ListView1.View = lvwReport        '   listivew的显示格式为报表格式
  ListView1.Sorted = True           '   listivew的排序属性为true
  ListView1.SortKey = 0         '   listivew排序的索引为 '货号', 从 0 开始
  ListView1.Gridlines = True        '   显示网格线
  ListView1.FullRowSelect = True    '   允许整行选中
  Label2.Caption = ""
  
  '设置循环,填充记录
  
  Dim rw As String
  rw = Sheet2.Range("G65536").End(xlUp).Row
  For i = 4 To rw
    Set ITM = ListView1.ListItems.Add()
    ITM.Text = Cells(i, 7)
    ITM.SubItems(1) = Cells(i, 8)
    ITM.SubItems(2) = Cells(i, 12)
    ITM.SubItems(3) = Cells(i, 13)
    ITM.SubItems(4) = Cells(i, 14)
    ITM.SubItems(5) = Cells(i, 15)
    ITM.SubItems(6) = Cells(i, 16)
    ITM.SubItems(7) = Cells(i, 17)
    ITM.SubItems(8) = Cells(i, 18)
    Next i
'End With
    Label2.Caption = "共找到 " & ListView1.ListItems.Count & " 条记录"
    TextBox1.SetFocus
End Sub
第一列的日期全变成同一天的了

chaplain

谢谢大家的无私奉献！