Snasui Excel Forum

Code: Select all

Name = Application.VLookup(LookFor.Value.Rng, ColName, 0)

Code: Select all

Name = Application.VLookup(LookFor.Value, Rng, ColName, 0)

Code: Select all

Private Sub CommandButton1_Click()
    Dim LookFor As Range
    Dim Rng As Range
    Dim ColAmount As Integer
    Dim ColName As Integer
    Dim Found As Variant
    Dim Name As Variant
    Dim rAll As Range
    Dim r As Range
    
    Set LookFor = Sheets("Sheet2").Range("A1")
    Set Rng = Sheets("Sheet1").Columns("A:C")
    With Sheets("Sheet2")
        Set rAll = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
    End With
    ColName = 2
    ColAmount = 3
    
    On Error Resume Next
    For Each r In rAll
        Found = Application.VLookup(r, Rng, ColAmount, 0)
        Name = Application.VLookup(r, Rng, ColName, 0)
        
        If IsError(Found) Then
            MsgBox LookFor & "äÁ辺¢éÍÁÙÅ"
        Else ': MsgBox "The look-up value of " & LookFor & " is " & Found & " in column " & Col
            r.Offset(0, 2) = Found
        End If
        
        If IsError(Name) Then
            MsgBox LookFor & "äÁ辺¢éÍÁÙÅ"
        Else
            r.Offset(0, 1) = Name
        End If
    Next r
    On Error GoTo 0
End Sub

Code: Select all

With Sheets("Sheet2")
        Set rAll = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
    End With

Code: Select all

For Each r In rAll
        Process .....
    Next r

Code: Select all

With Sheets("Sheet2")
        Set rAll = .Range("A1", .Range("A" & Rows.Count).End(xlUp)) 'กำหนดให้ rAll มีค่าตั้งแต่ A1 จนถึงค่า A สุดท้ายที่มีข้อมูล
End With

Code: Select all

For Each r In rAll
        Process ..... ' Process คือการดำเนินการกับสมาชิกแต่ละตัว (แทนค่าด้วย r) ใน rAll
Next r

Code: Select all

Set FoundRange = Columns(1).Find(What:=Range("A" & Rows.Count).End(xlUp))  'ãËéËÒ¤Ó·ÕèàËÁ×͹㹠Colum A
    If Not (FoundRange Is Nothing) Then '¶éÒà¨ÍÇèÒ«éÓ
        MsgBox ("ÁÕ¢éÍÁÙÅ«éÓã¹°Ò¹¢éÍÁÙÅ")
        Range("A" & Rows.Count).End(xlUp) = ""
        Range("A" & Rows.Count).End(xlUp).Activate
        GoTo EndProcess
    End If

Code: Select all

If IsError(Amount) Then
            Range("A" & Rows.Count).End(xlUp).Application.Selection.Font.ColorIndex = 3
            Range("A" & Rows.Count).End(xlUp).Application.Selection.Font.Bold = True
        Else
            r.Offset(0, 2) = Amount
        End If

Code: Select all

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rng As Range
Dim ColAmount As Integer
Dim ColName As Integer
Dim Amount As Variant
Dim Name As Variant
Dim rAll As Range
Dim r As Range
Dim FoundRange As Range

If Range("A" & Rows.Count).End(xlUp) <> "" Then
    Set FoundRange = Columns(1).Find(What:=Range("A" & Rows.Count).End(xlUp))  'ãËéËÒ¤Ó·ÕèàËÁ×͹㹠Colum A
    If Not (FoundRange Is Nothing) Then '¶éÒà¨ÍÇèÒ«éÓ
        MsgBox ("ÁÕ¢éÍÁÙÅ«éÓã¹°Ò¹¢éÍÁÙÅ")
        Range("A" & Rows.Count).End(xlUp) = ""
        Range("A" & Rows.Count).End(xlUp).Activate
        GoTo EndProcess
    End If

    Set LookFor = Sheets("Sheet2").Range("A1")
    Set Rng = Sheets("Sheet1").Columns("A:C")
    With Sheets("Sheet2")
        Set rAll = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
    End With
    ColName = 2
    ColAmount = 3
    
    On Error Resume Next
    For Each r In rAll
        Amount = Application.VLookup(r, Rng, ColAmount, 0)
        Name = Application.VLookup(r, Rng, ColName, 0)
        
        If IsError(Amount) Then
            Range("A" & Rows.Count).End(xlUp).Application.Selection.Font.ColorIndex = 3
            Range("A" & Rows.Count).End(xlUp).Application.Selection.Font.Bold = True
        Else
            r.Offset(0, 2) = Amount
        End If
        
        If IsError(Name) Then
            'MsgBox r.Offset(0, 0) & "  äÁèÁÕª×èÍÅÙ¡¤éÒã¹°Ò¹¢éÍÁÙÅ"
            'r.Offset(0, 0) = "" '·ÓãËé¢éÍÁÙÅ㹺Ã÷ѴÊØ´ã¹ Column A à»ç¹ ÇèÒ§
            'r.Offset(0, 0).Activate '仺Ã÷ѴÊØ´·éÒÂã¹ Column A
            Exit Sub
        Else
            r.Offset(0, 1) = Name
        End If
    Next r
End If
    
EndProcess:
    On Error GoTo 0
End Sub

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range
    Dim rCheck As Range
    Dim ColAmount As Integer
    Dim ColName As Integer
    Dim lng As Long
    If Target.Column = 1 Then
        With Sheets("Sheet2")
            Set rCheck = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
        End With
        With Sheets("Sheet1")
            Set Rng = .Range("A1", .Range("C" & Rows.Count).End(xlUp))
        End With
        ColName = 2
        ColAmount = 3
        On Error Resume Next
        lng = Application.CountIf(Rng.Resize(, 1), Target)
        If lng >= 1 Then
            If Application.CountIf(Target, rCheck) > 1 Then
                MsgBox ("Double!!!")
            End If
            Target.Offset(0, 2) = Application.VLookup(Target, Rng, ColAmount, 0)
            Target.Offset(0, 1) = Application.VLookup(Target, Rng, ColName, 0)
        Else
             Target.Font.Color = vbRed
             Target.Font.Bold = True
        End If
    End If
End Sub