Snasui Excel Forum

Code: Select all

Sub test0()
    Dim rSoruce As Range, rs As Range
    Dim rTarget As Range
    With Sheets("Data")
        Set rsource = .Range("A2", _
            .Range("A" & Rows.Count).End(xlUp))
    End With
    Set rTarget = Sheets("Sheet2").Range("A1")
    For Each rs In rsource
        If rs = rTarget Then
            With Sheets("Sheet2")
                If .Range("B1") = "" Then
                    .Range("B" & Rows.Count) _
                        .End(xlUp) = rs.Offset(0, 1)
                    .Range("C" & Rows.Count) _
                        .End(xlUp) = rs.Offset(0, 2)
                Else
                    .Range("B" & Rows.Count) _
                        .End(xlUp).Offset(1, 0) = rs.Offset(0, 1)
                    .Range("C" & Rows.Count) _
                        .End(xlUp).Offset(1, 0) = rs.Offset(0, 2)
                End If
            End With
        End If
    Next rs
End Sub

Code: Select all

Private Sub CommandButton1_Click()
    Dim LookFor 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
    
    Set LookFor = Sheets("Sheet2").Range("A1")
    Set Rng = Sheets("Data").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
        With Application
            'Amount = Application.VLookup(r, Rng, ColAmount, 0)
            'Name = Application.VLookup(r, Rng, ColName, 0)
            Amount = .Index(Rng.Offset(0, 2).Resize(, 1), .Match(r, Rng.Resize(, 1), 0))
            Name = .Index(Rng.Offset(0, 1).Resize(, 1), .Match(r, Rng.Resize(, 1), 0))
        End With
        
        
        If IsError(Amount) Then
            MsgBox r.Offset(0, 0) & "  ไม่มียอดเงินในฐานข้อมูล"
        Else
            r.Offset(0, 2) = Amount
            r.Offset(1, 2) = Amount
        End If
        
        If IsError(Name) Then
            'MsgBox r.Offset(0, 0) & "  ไม่มีชื่อลูกค้าในฐานข้อมูล"
            'r.Offset(0, 0) = "" 'ทำให้ข้อมูลในบรรทัดสุดใน Colum A เป็น ว่าง
            'r.Offset(0, 0).Activate
        Else
            r.Offset(0, 1) = Name
            r.Offset(1, 1) = Name
        End If
    Next r
    On Error GoTo 0
End Sub

Code: Select all

With Application
'    Amount = Application.VLookup(r, Rng, ColAmount, 0)
'    Name = Application.VLookup(r, Rng, ColName, 0)
     Amount = .Index(Rng.Offset(0, 2).Resize(, 1), .Match(r, Rng.Resize(, 1), 0))
     Name = .Index(Rng.Offset(0, 1).Resize(, 1), .Match(r, Rng.Resize(, 1), 0))
End With