listbox查询显示问题

常被人骗

过年时间打算弄个VBA代码减轻明年工作压力   现在卡在listbox 这里了  求各位高人帮我解决，谢谢！

microyip

简单的范例，你变通修改一下就可以了

1. Private Sub UserForm_Initialize()
   
2.     Dim vData As Variant
   
3.     vData = [{1,2,3;4,5,6}]
   
4.     With ListBox1
   
5.         .ColumnCount = 3
   
6.         .List = vData
   
7.         .ColumnWidths = "30,50"
   
8.     End With
   
9. End Sub
   

复制代码

魂断蓝桥

Private Sub CommandButton1_Click()
    Dim cnn, rs As Object, Sql As String, myf$, i%, j%
    Set cnn = CreateObject("adodb.connection")
    Set rs = CreateObject("adodb.Recordset")
    myf = ThisWorkbook.Path & "\test1.xlsx"
    cnn.Open "Provider=Microsoft.ACE.OleDb.12.0;Extended Properties='Excel 12.0;HDR=YES'; Data Source=" & myf
    Sql = "select * from [sheet1$b3:g] where 客户简称 LIKE '%" & Me.TextBox1 & "%'"
    rs.Open Sql, cnn, 1, 1
    If rs.RecordCount = 0 Then Set rs = Nothing: Set cnn = Nothing: Exit Sub
    Me.ListBox1.ColumnCount = 6
    Me.ListBox1.Font.Name = "微软雅黑"
    Me.ListBox1.Font.Size = 10
    Me.ListBox1.Clear
    ListBox1.AddItem
    For j = 0 To rs.Fields.Count - 1
        ListBox1.List(0, j) = rs.Fields(j).Name
    Next
    Do While Not rs.EOF
        ListBox1.AddItem
        i = i + 1
        ListBox1.List(i, 0) = rs.Fields(0) & ""
        ListBox1.List(i, 1) = rs.Fields(1) & ""
        ListBox1.List(i, 2) = rs.Fields(2) & ""
        ListBox1.List(i, 3) = rs.Fields(3) & ""
        ListBox1.List(i, 4) = rs.Fields(4) & ""
        ListBox1.List(i, 5) = rs.Fields(5) & ""
        rs.MoveNext
    Loop
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
    Me.TextBox2 = Me.ListBox1.List(1, 0)
    Me.TextBox3 = Me.ListBox1.List(1, 2)
    Me.TextBox4 = Me.ListBox1.List(1, 3)
    Me.TextBox5 = Me.ListBox1.List(1, 5)
End Sub
'rs.RecordCount
'transform first(答案值字段) select 问题 from [Sheet1$] group by 问题 pivot 姓名列字段
'cnn.BeginTrans
'cnn.CommitTrans
'cnn.RollbackTrans
'arr = Application.Transpose(cnn.Execute(Sql).GetRows)
Sub A()
    Dim cnn, rs As Object, Sql As String, i%
    Set cnn = CreateObject("adodb.connection")
    Set rs = CreateObject("adodb.Recordset")
    cnn.Open "Provider=Microsoft.ACE.OleDb.12.0;Extended Properties='Excel 12.0;HDR=YES'; Data Source=" & ThisWorkbook.FullName
    cnn.Open "Provider=Microsoft.jet.oledb.4.0;Extended Properties='Excel 8.0;HDR=YES'; Data Source=" & ThisWorkbook.FullName
   
    Sql = "select 日期,姓名,""计件"" AS 类别,计件 as 数量 from [sheet1$A1:E5]  UNION ALL " _
    & "select 日期,姓名,""临工"" ,临工 from [sheet1$A1:E5]"
    Sql = "transform sum(数量) SELECT 姓名,类别 FROM(" & Sql & ") GROUP BY 姓名,类别 PIVOT 日期"
    rs.Open Sql, cnn, 1, 1
    For i = 0 To rs.Fields.Count - 1
        Cells(7, i + 1) = rs.Fields(i).Name
    Next
    Range("a8").CopyFromRecordset rs
    Set rs = Nothing
    Set cnn = Nothing
End Sub

蓝桥玄霜

常被人骗

蓝桥玄霜 发表于 2020-1-20 09:35

非常感谢，完美解决了我的问题