Page 1 of 1

ต่อเนื่องจาก Vlook ด้วย VBA

Posted: Mon Sep 10, 2012 9:31 pm
by akung
จากกระทู้นี้ครับ http://www.snasui.com/viewtopic.php?f=3&t=3179&start=20 ผมจึงมีแนวคิดมารบกวนอาจารย์อีกแล้วครับ คือผมคิดว่าในเมือ VBA สามารถทำงานลักษณะ Vlookup ได้ VBA ก็น่าจะสามารถดึงข้อมูลการ เหมือน Index + Match ได้เหมือนกัน แต่พยายามลองทำดูแล้วข้อมูลก็ไม่ยอมมาอย่างทีคิด คิดมาทั้งวันคิดไม่ออก เขียนไปไกลพอสมควร จนมั่วไปหมด สุดท้ายเลยกลับมาเริ่มที่จุดเริ่มต้นใหม่อีกครั้ง รบกวนอาจารย์ชี้แนะด้วยครับ

Re: ต่อเนื่องจาก Vlook ด้วย VBA

Posted: Mon Sep 10, 2012 9:54 pm
by snasui
:D ช่วยโพสต์ Code ที่ได้ลองแล้วพร้อมไฟล์แนบมาด้วยครับ

Re: ต่อเนื่องจาก Vlook ด้วย VBA

Posted: Mon Sep 10, 2012 10:00 pm
by akung
snasui wrote::D ช่วยโพสต์ Code ที่ได้ลองแล้วพร้อมไฟล์แนบมาด้วยครับ
ขอโทษครับ :oops: ลืมแนบซะงั้น :tt:

Re: ต่อเนื่องจาก Vlook ด้วย VBA

Posted: Mon Sep 10, 2012 10:18 pm
by snasui
:D ลองดูตัวอย่างการปรับ Code ตามด้านล่างครับ

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

Re: ต่อเนื่องจาก Vlook ด้วย VBA

Posted: Mon Sep 10, 2012 10:25 pm
by akung
snasui wrote::D ลองดูตัวอย่างการปรับ Code ตามด้านล่างครับ

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
ขอบคุณครับอาจารย์

Re: ต่อเนื่องจาก Vlook ด้วย VBA

Posted: Tue Sep 11, 2012 9:10 pm
by akung
สูตรที่อาจารย์ใบ้มาให้ ผมก็ยังตีไม่แตก :oops:

แต่คิดไปเรื่อย ๆ เอาตัวอย่างโน้นนี้มาใส่ คิดว่าน่าจะได้แล้วกลับไม่ได้ ไม่รู้ว่าเพราะอะไร รบกวนอาจารย์ช่วยชี้แนะหน่อยครับ สูตรใหม่ที่คิดอยู่ใน Sheets SeekList ครับ ขอบคุณครับ

Re: ต่อเนื่องจาก Vlook ด้วย VBA

Posted: Tue Sep 11, 2012 9:33 pm
by snasui
:D Code นั้นไม่ได้ใบ้ครับ ต้องนำไปใส่ตามนั้น

ส่วนที่บอกว่าไม่ได้ ยังติดอะไร ช่วยอธิบายรายละเอียดพร้อมวิธีทดสอบให้เกิดปัญหาเช่นนั้นมาด้วยครับ

Re: ต่อเนื่องจาก Vlook ด้วย VBA

Posted: Tue Sep 11, 2012 9:48 pm
by akung
snasui wrote::D Code นั้นไม่ได้ใบ้ครับ ต้องนำไปใส่ตามนั้น

ส่วนที่บอกว่าไม่ได้ ยังติดอะไร ช่วยอธิบายรายละเอียดพร้อมวิธีทดสอบให้เกิดปัญหาเช่นนั้นมาด้วยครับ

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 ที่อาจารย์ให้ไปใส่แทน Code Vlookup ครับ
แล้วผมก็ใส่ เลข 12345 ที่ A1 แล้วกดปุ่ม
ข้อมูลที่ต้องการควรจะเป็น

12345 นาย ก. 100
นาย ก. 250
นาย ก. 300

แต่มันออกแค่

12345 นาย ก. 100 แค่นั้นครับ

Re: ต่อเนื่องจาก Vlook ด้วย VBA

Posted: Tue Sep 11, 2012 10:10 pm
by snasui
:D ควรจะเขียนอธิบายสิ่งที่ต้องการมาเช่นนี้เสมอจะได้เข้าใจตรงกัน Vlookup หรือ Indirect+Match ไม่สามารถ Loop เพื่อนำทุกค่าที่ตรงกับค่าเป้าหมายมาแสดงได้ เพราะจะเจอตัวแรกอยู่เสมอไป

ตัวอย่างการ Loop เพื่อนำค่าที่ตรงกับค่าเป้าหมายมาแสดงทั้งหมดตามด้านล่างครับ

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

Re: ต่อเนื่องจาก Vlook ด้วย VBA

Posted: Tue Sep 11, 2012 10:15 pm
by akung
snasui wrote::D ควรจะเขียนอธิบายสิ่งที่ต้องการมาเช่นนี้เสมอจะได้เข้าใจตรงกัน Vlookup หรือ Indirect+Match ไม่สามารถ Loop เพื่อนำทุกค่าที่ตรงกับค่าเป้าหมายมาแสดงได้ เพราะจะเจอตัวแรกอยู่เสมอไป

ตัวอย่างการ Loop เพื่อนำค่าที่ตรงกับค่าเป้าหมายมาแสดงทั้งหมดตามด้านล่างครับ

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
ขอบคุณครับ ผมจะค่อยแกะดูครับ :D