Question

我目前正在处理数据表集。我想在表范围内搜索一个字符串，并在列表框中获取多个行。但是，我没有实现如下标题表名的目标

 Private Sub cmdSSearch_Click()

    Me.cbxASearch.Value = ""
    Me.Tcountry4search.Value = ""

    Me.Width = 800
    Me.LbxSearch.Width = 660
    Me.LSearch2.Width = 20



    Dim h As Long

    Me.LbxSearch.Clear
    Me.LSearch2.Clear

    'for column header
    With Me.LbxSearch
        .AddItem

        .List(0, 0) = Sheets("Data entry").Cells(10, 27)
        .List(0, 1) = Sheets("Data entry").Cells(10, 28)
        .List(0, 2) = Sheets("Data entry").Cells(10, 32)
        .List(0, 3) = Sheets("Data entry").Cells(10, 33)
        .List(0, 4) = Sheets("Data entry").Cells(10, 34)
        .List(0, 5) = Sheets("Data entry").Cells(10, 35)
        .List(0, 6) = Sheets("Data entry").Cells(10, 36)
        .List(0, 7) = Sheets("Data entry").Cells(10, 37)
        .List(0, 8) = Sheets("Data entry").Cells(10, 44)
        .List(0, 9) = Sheets("Data entry").Cells(10, 46)

        .ColumnWidths = "50,100,100,100,70,70,30,30,50,0"
        .ColumnCount = 10
        .Selected(0) = True
End With

'for listbox fill
On Error Resume Next
For h = 2 To Sheets("Data entry").Range("AA10000").End(xlUp).Offset(1, 0).Row
For i = 1 To 100
s = Application.WorksheetFunction.CountIf(Sheets("Data entry").Range("AA" & h, "AT" & h), Sheets("Data entry").Cells(h, i))
If s = 1 And Sheets("Data entry").Cells(h, i) = Me.cbxSSearch.Value Then
Me.LbxSearch.AddItem

Me.LbxSearch.List(LbxSearch.ListCount - 1, 0) = Sheets("Data entry").Cells(h, 27)
Me.LbxSearch.List(LbxSearch.ListCount - 1, 1) = Sheets("Data entry").Cells(h, 28)
Me.LbxSearch.List(LbxSearch.ListCount - 1, 2) = Sheets("Data entry").Cells(h, 32)
Me.LbxSearch.List(LbxSearch.ListCount - 1, 3) = Sheets("Data entry").Cells(h, 33)
Me.LbxSearch.List(LbxSearch.ListCount - 1, 4) = Format(Sheets("Data entry").Cells(h, 34), "dd-mmm-yy")
Me.LbxSearch.List(LbxSearch.ListCount - 1, 5) = Format(Sheets("Data entry").Cells(h, 35), "dd-mmm-yy")
Me.LbxSearch.List(LbxSearch.ListCount - 1, 6) = Sheets("Data entry").Cells(h, 36)
Me.LbxSearch.List(LbxSearch.ListCount - 1, 7) = Sheets("Data entry").Cells(h, 37)
Me.LbxSearch.List(LbxSearch.ListCount - 1, 8) = Sheets("Data entry").Cells(h, 44)
Me.LbxSearch.List(LbxSearch.ListCount - 1, 9) = Sheets("Data entry").Cells(h, 46)
End If

Next i
Next h

End Sub

不幸的是，columns表正在移动或添加更多的列，这会造成挫败感。然后，我尝试定位标头表名称，但未成功。有人可以帮忙吗？

Private Sub cmdSSearch_Click()


'clear other text search
Me.cbxASearch.Value = ""
Me.Tcountry4search.Value = ""


Me.Width = 800
Me.LbxSearch.Width = 700
Me.LSearch2.Width = 20
Me.LbxSearch.Clear
Me.LSearch2.Clear



'for column header
With Me.LbxSearch
    .AddItem

    .List(0, 0) = "Region"
    .List(0, 1) = "Host country"
    .List(0, 2) = "Scope"
    .List(0, 3) = "Participating countries"
    .List(0, 4) = "Type of participants"
    .List(0, 5) = "Language"
    .List(0, 6) = "Type of Training"
    .List(0, 7) = "Start date"
    .List(0, 8) = "End date"
    .List(0, 9) = "sr"


    .ColumnWidths = "50,100,50,100,100,50,70,70,70,0"
    .ColumnCount = 10
    .Selected(0) = True

End With


'for listbox fill
On Error Resume Next
For h = 1 To Sheets("Data entry").Range("Training_tracker[Region]").Rows.Count
For i = 1 To Sheets("Data entry").Range("Training_tracker").Columns.Count
s = Application.WorksheetFunction.CountIf(Sheets("Data entry").ListObjects("Training_tracker").ListRows(h).Range, Sheets("Data entry").ListObjects("Training_tracker").DataBodyRange(h, i))  'if not work change DataBodyRange  instead of"Cells" '
If s = 1 And Sheets("Data entry").ListObjects("Training_tracker").Cells(h, i) = Me.cbxSSearch.Value Then
Me.LbxSearch.AddItem

Me.LbxSearch.List(LbxSearch.ListCount - 1, 0) = Sheets("Data entry").ListObjects("Training_tracker").Cells(h, Sheets("Data entry").ListObjects("Training_tracker").ListColumns("Region"))
Me.LbxSearch.List(LbxSearch.ListCount - 1, 1) = Sheets("Data entry").ListObjects("Training_tracker").Cells(h, Sheets("Data entry").ListObjects("Training_tracker").ListColumns("Host country "))
Me.LbxSearch.List(LbxSearch.ListCount - 1, 2) = Sheets("Data entry").ListObjects("Training_tracker").Cells(h, Sheets("Data entry").ListObjects("Training_tracker").ListColumns("Scope"))
Me.LbxSearch.List(LbxSearch.ListCount - 1, 3) = Sheets("Data entry").ListObjects("Training_tracker").Cells(h, Sheets("Data entry").ListObjects("Training_tracker").ListColumns("Participating countries"))
Me.LbxSearch.List(LbxSearch.ListCount - 1, 4) = Sheets("Data entry").ListObjects("Training_tracker").Cells(h, Sheets("Data entry").ListObjects("Training_tracker").ListColumns("Type of participants"))
Me.LbxSearch.List(LbxSearch.ListCount - 1, 5) = Sheets("Data entry").ListObjects("Training_tracker").Cells(h, Sheets("Data entry").ListObjects("Training_tracker").ListColumns("Language"))
Me.LbxSearch.List(LbxSearch.ListCount - 1, 6) = Sheets("Data entry").ListObjects("Training_tracker").Cells(h, Sheets("Data entry").ListObjects("Training_tracker").ListColumns("Type of Training"))
Me.LbxSearch.List(LbxSearch.ListCount - 1, 7) = Format(Sheets("Data entry").ListObjects("Training_tracker").Cells(h, Sheets("Data entry").ListObjects("Training_tracker").ListColumns("Start date")).Text, "dd-mmm-yy")
Me.LbxSearch.List(LbxSearch.ListCount - 1, 8) = Format(Sheets("Data entry").ListObjects("Training_tracker").Cells(h, Sheets("Data entry").ListObjects("Training_tracker").ListColumns("End date")).Text, "dd-mmm-yy")
Me.LbxSearch.List(LbxSearch.ListCount - 1, 9) = Sheets("Data entry").ListObjects("Training_tracker").Cells(h, Sheets("Data entry").ListObjects("Training_tracker").ListColumns("sr"))


End If

Next i
Next h

End Sub

VBA在表范围内循环值并显示多行

0 个答案: