如何使用最后一行中的一组可变行填充用户窗体中的列表框？

Question

我有一个工作表“Sheet1”，数据范围为“A:R”，在输入新条目时行不断添加。每个条目的行范围都不同，因此“A 列”中的行会重复，这样它就可以很好地显示在数据透视表中。现在要检查最后一个条目是否实际上已粘贴，一种检查方法是按“Cltr+Down”键。我有一个用户窗体中的列表框来填充最后输入的条目。但它只显示 1 行，即最后一行。如何显示该特定条目是否假设有 5 行？

我有这段代码，它显示输入的最后一行。我知道缺少定义范围的主要块。我只是不知道该怎么做。请帮忙。 这是我需要在用户窗体中填充列表框的数据库的屏幕截图。

这是我单击“CommandButton1”时带有 ListBox 的用户窗体的屏幕截图

Screenshot of Userform when 'CommandButton1' is clicked

Private Sub CommandButton1_Click()
Dim Rng As Range
Dim lr As Long
Dim x(1 To 2, 1 To 18), y As Long
    With Worksheets("Sheet1")
         lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        UserForm1.ListBox1.ColumnCount = 18
        For y = 1 To 18
            x(1, y) = .Cells(1, y)
            x(2, y) = .Cells(lr, y)
        Next y
              UserForm1.ListBox1.List = x
    End With
UserForm1.Show
End Sub

我希望 025 - GRACE PHILLIPS（来自数据库）的记录显示在 ListBox 上，稍后添加新条目时，它应该显示输入的新条目

Answer 1

让我们使用 ADODB.recordset 尝试另一种方法

  Option Explicit

Private Sub CommandButton1_Click()

    Dim criteria As String, fldName As String, shtName As String
    Dim con As Object  ' ADODB.Connection
    Dim rcd As Object  ' ADODB.Recordset
    Dim colCount As Long

    ' Assuming the list has a header
    Set con = GetExcelConnection(ThisWorkbook.FullName, True)

    Set rcd = CreateObject("ADODB.Recordset")
    'Set rcd = New ADODB.Recordset

    ' Assuming the list is on the first sheet and
    shtName = ThisWorkbook.Sheets(1).Name

    ' Reading the list into a recordset
    With rcd
        .ActiveConnection = con
        .CursorType = 2  ' adOpenDynamic
        .LockType = 3    ' adLockOptimistic
        .Source = "SELECT * FROM [" & shtName & "$]"
        .Open
    End With

    colCount = rcd.Fields.Count + 1
    ' Move to the last record in the list
    rcd.MoveLast

    ' Trying to find the row where S.L.No. does contain avalue
    Do While IsNull(rcd.Fields(0).Value)
        rcd.MovePrevious
        If rcd.BOF Then
            MsgBox "No S.L.No found", vbOKOnly + vbCritical, "Error - Exit"
            Exit Sub
        End If
    Loop

    ' get the value and the fieldname for the filter
    criteria = rcd.Fields(0).Value
    fldName = rcd.Fields(0).Name


    ' Filter the list by the value in the first column and last row
    ' This assumes you do not have different areas with the same value
    rcd.Filter = fldName & " = '" & criteria & "'"

    ' Prpearing everything for the Userform
    Dim frm As New UserForm1
    Load frm
    With frm
        .ListBox1.ColumnCount = colCount
        .ListBox1.Column = rcd.GetRows   ' This transfers the filtered records into the lsitbox
        .Show
    End With

End Sub

Function GetExcelConnection(ByVal Path As String, _
    Optional ByVal Headers As Boolean = True) As Object
    Dim strConn As String
    Dim objConn As Object ' ADODB.Connection
    Set objConn = CreateObject("ADODB.Connection")
    strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & Path & ";" & _
        "Extended Properties=""Excel 8.0;HDR=" & _
        IIf(Headers, "Yes", "No") & """"
    objConn.Open strConn
    Set GetExcelConnection = objConn
End Function

Answer 2

我会这样做

选项 1 您可以使用 CurrentRegion 来获取范围。我不确定这是否适合你。

Private Sub CommandButton1_Click()
    Dim rg As Range
    Set rg = Range("A1").CurrentRegion
    ListBox1.List = rg.Value
End Sub

选项 2 或者您像在发布的代码中那样确定最后一行并使用它

Private Sub CommandButton1_Click()
    Dim rg As Range
    Dim lr As Long
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    Set rg = Range("A1:R" & lr)
    ListBox1.List = rg.Value
End SUb

请根据需要添加工作表和用户表单参考

更新基于 选项 2 中 rg 的注释使用以下行

Set rg = Range("A" & lr & ":R" & lr)

更新 2 我假设您要添加到列表框中的行由包含 S.L.No. 的第一列标识。

Private Sub CommandButton2_Click()

    Dim rg As Range, rg1 As Range
    Dim lr As Long

    lr = Cells(Rows.Count, 1).End(xlUp).Row
    Set rg = Range("A1" & ":R" & lr)

    rg.AutoFilter Field:=1, Criteria1:=rg.Cells(lr, 1).Value
    Set rg1 = rg.SpecialCells(xlCellTypeVisible)
   ' Assumption is the newly added rows are in one and therefore in the last area
    Set rg1 = rg1.Areas(rg1.Areas.Count)


    ListBox1.ColumnCount = rg.Columns.Count
    ListBox1.List = rg1.Value

    rg.AutoFilter
End Sub