Snasui Excel Forum

Code: Select all

Private Sub UserForm_Initialize()
 LoadAllData
 TextBox1.SetFocus
End Sub

Sub LoadAllData()
    LastRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
    For ShRow = 1 To LastRow
                        For ListCol = 2 To 4
                            Me.ListBox1.AddItem
                            Me.ListBox1.List(ShRow - 1, ListCol - 2) = Sheet1.Cells(ShRow, ListCol).Value
                        Next ListCol
    Next ShRow
End Sub

Code: Select all

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    ActiveCell.Value = ListBox1.Value
'    ListBox1.Value = ""
    ActiveCell.Offset(1, 0).Select
End Sub

Code: Select all

    ActiveCell.Value = Application.Index(Sheets("Data").Range("ColBB"), ListBox1.ListIndex + 1)
    ActiveCell.Offset(, 1).Value = Application.Index(Sheets("Data").Range("ColCC"), ListBox1.ListIndex + 1)
    ActiveCell.Offset(, 2).Value = Application.Index(Sheets("Data").Range("ColDD"), ListBox1.ListIndex + 1)
    ActiveCell.Offset(1, 0).Select

Code: Select all

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    ActiveCell.Value = ListBox1.List(ListBox1.ListIndex)
    ActiveCell.Offset(, 1).Value = ListBox1.List(ListBox1.ListIndex, 1)
    ActiveCell.Offset(, 2).Value = ListBox1.List(ListBox1.ListIndex, 2)
    ListBox1.Value = ""
    ActiveCell.Offset(1, 0).Select
End Sub

Code: Select all

Sub LoadAllData()
    LastRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
    For ShRow = 1 To LastRow
'                        For ListCol = 2 To 4
                            Me.ListBox1.AddItem
                            Me.ListBox1.List(ShRow - 1, 0) = Sheet1.Cells(ShRow, 2).Value
                            Me.ListBox1.List(ShRow - 1, 1) = Sheet1.Cells(ShRow, 3).Value
                            Me.ListBox1.List(ShRow - 1, 2) = Sheet1.Cells(ShRow, 4).Value
'                        Next ListCol
    Next ShRow
End Sub

Code: Select all

Sub LoadAllData()
    LastRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
    For ShRow = 1 To LastRow
'                        For ListCol = 2 To 4
                            Me.ListBox1.AddItem
                            Me.ListBox1.List(ShRow - 1, 0) = Sheet1.Cells(ShRow, 2).Value
                            Me.ListBox1.List(ShRow - 1, 1) = Sheet1.Cells(ShRow, 3).Value
                            Me.ListBox1.List(ShRow - 1, 2) = Sheet1.Cells(ShRow, 4).Value
'                        Next ListCol
    Next ShRow
End Sub
[code]
หรือ
[code]
Private Sub TextBox1_AfterUpdate()
'    'Add Column headers
'    With Me.ListBox1
'    .Clear
'        For ColHead = 2 To 4
'            .AddItem
'            .List(0, ColHead - 2) = Sheet1.Cells(1, ColHead).Value
'        Next ColHead
'    ListRow = 1
'    If IsDate(Me.TextBox1) Then
'        FindVal = CDate(Me.TextBox1)
'        ElseIf IsNumeric(Me.TextBox1) Then FindVal = Val(Me.TextBox1)
'        Else
'        FindVal = "*" & Me.TextBox1 & "*"
'    End If
'    LastRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
'    For ShRow = 2 To LastRow
'            FindRow = Application.WorksheetFunction.CountIf(Sheet1.Rows(ShRow).EntireRow, FindVal)
'            If FindRow > 0 Then
'                        For ListCol = 2 To 4
'                            .AddItem
'                            .List(ListRow, ListCol - 2) = Sheet1.Cells(ShRow, ListCol).Value
'                        Next ListCol
'                    ListRow = ListRow + 1
'            End If
'    Next ShRow
'    End With
End Sub

Code: Select all

Private Sub TextBox1_Change()
'    'Add Column headers
    With Me.ListBox1
    .Clear
        For ColHead = 2 To 4
            .AddItem
            .List(0, ColHead - 2) = Sheet1.Cells(1, ColHead).Value
        Next ColHead
    ListRow = 1
    If IsDate(Me.TextBox1) Then
        FindVal = CDate(Me.TextBox1)
        ElseIf IsNumeric(Me.TextBox1) Then FindVal = Val(Me.TextBox1)
        Else
        FindVal = "*" & Me.TextBox1 & "*"
    End If
    LastRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
    For ShRow = 2 To LastRow
            FindRow = Application.WorksheetFunction.CountIf(Sheet1.Rows(ShRow).EntireRow, FindVal)
            If FindRow > 0 Then
                        For ListCol = 2 To 4
                            .AddItem
                            .List(ListRow, ListCol - 2) = Sheet1.Cells(ShRow, ListCol).Value
                        Next ListCol
                    ListRow = ListRow + 1
            End If
    Next ShRow
    End With
End Sub

Code: Select all

Private Sub TextBox1_AfterUpdate()

Code: Select all

Private Sub TextBox1_Change()

Code: Select all

Private Sub TextBox1_Change()
'    'Add Column headers
    With Me.ListBox1
    .Clear
        For ColHead = 3 To 5
            .AddItem
            .List(0, ColHead - 2) = Sheet1.Cells(1, ColHead).Value
        Next ColHead
    ListRow = 1
    If IsDate(Me.TextBox1) Then
        FindVal = CDate(Me.TextBox1)
        ElseIf IsNumeric(Me.TextBox1) Then FindVal = Val(Me.TextBox1)
        Else
        FindVal = "*" & Me.TextBox1 & "*"
    End If
    LastRow = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
    For ShRow = 3 To LastRow
            FindRow = Application.WorksheetFunction.CountIf(Sheet1.Rows(ShRow).EntireRow, FindVal)
            If FindRow > 0 Then
                        For ListCol = 3 To 5
                            .AddItem
                            .List(ListRow, ListCol - 3) = Sheet1.Cells(ShRow, ListCol).Value
                        Next ListCol
                    ListRow = ListRow + 1
            End If
    Next ShRow
    End With
End Sub