ขออนุญาตสอบถาการใช้ Vlookup ใน vba เพื่อหาค่าที่ตรงตามเงื่อนไข

[9KiTTi]

ขออนุญาตสอบถามการใช้ Vlookup ใน vba โดยมีเงื่อนไขเปลี่ยนจากรหัสจังหวัดในชีท comp1 ถึง comp3 ของคอลัมม์ d เป็นชื่อจังหวัด เช่น เปลี่ยนรหัส 12 ในคอลัมม์ D8 ชีท comp1 เปลี่ยนเป็น นนทบุรี

Code: Select all

Sub paidpro()
    Dim sh As Worksheet
    Dim itme As Long
    Dim otme As Long
    Application.DisplayAlerts = False
    For Each sh In Worksheets
        If sh.Index > 3 Then
            With Sheets("Main")
                With sh
                    cp = Application.Match("central", .Range("a1:a50000"), 0)
                    op = Application.Match("country", .Range("a5:a50000"), 0)
                End With
            If Application.CountIfs(.Range("b6:b30"), sh.Name) = 0 Then
                With .Range("b30").End(xlUp).Offset(1, 0)
                    .Value = sh.Name
                    .Offset(0, 2).Value = Application.VLookup(sh.Range("d" & cp & ":d" & op), 2, 0)
                End With
            End If
            End With
        End If
    Next sh
   Application.DisplayAlerts = True
End Sub

ผมพยายามเอา code จากงานตัวเก่ามาปรับแต่ยังไม่ได้ พอรัน vb ข้อมูลจะไปแสดงที่ชีท main และค่าที่แสดงไม่ตรงกับที่ต้องการ
ขอความอนุเคราะห์ชี้แนะด้วย ขอบพระคุณครับ

[puriwutpokin]

ลองปรับตามนี้ดูครับ

Code: Select all

Sub paidpro()
    Dim sh As Worksheet
    Dim r As Range
    Application.DisplayAlerts = False
    On Error Resume Next
    For Each sh In Worksheets
        If sh.Index > 3 Then
            With Sheets("province")
              For Each r In sh.Range("d8:d99")
            r.Value = Application.IfError(Application. _
            VLookup(r.Text, Sheets("province").Range("a2:b79"), 2, 0), "Not foud")
                    Next r
            End With
        End If
    Next sh
   Application.DisplayAlerts = True
End Sub

[9KiTTi]

ลองปรับตามนี้ดูครับ

Code: Select all

Sub paidpro()
    Dim sh As Worksheet
    Dim r As Range
    Application.DisplayAlerts = False
    On Error Resume Next
    For Each sh In Worksheets
        If sh.Index > 3 Then
            With Sheets("province")
              For Each r In sh.Range("d8:d99")
            r.Value = Application.IfError(Application. _
            VLookup(r.Text, Sheets("province").Range("a2:b79"), 2, 0), "Not foud")
                    Next r
            End With
        End If
    Next sh
   Application.DisplayAlerts = True
End Sub

ผมได้ปรับตามที่อาจารย์แนะนำแล้วครับ ในส่วนของการแทนค่ารหัสจังหวัดด้วยชื่อจังหวัดสามารถทำได้แล้ว แต่พบปัญหาว่าหลังจากรัน macro พบว่าในส่วนของหัวคอลลัมม์ 'province' ในส่วนของข้อมูล Country หายไปครับ รกกวนแนะนำด้วยครับ ขอบพระคุณครับ

[puriwutpokin]

ปรับตามนี้ครับ

Code: Select all

Sub paidpro()
    Dim sh As Worksheet
    Dim r As Range
    Application.DisplayAlerts = False
    On Error Resume Next
    For Each sh In Worksheets
        If sh.Index > 3 Then
            With Sheets("province")
              For Each r In sh.Range("d8:d10000")
              If Len(r.Text) < 3 Then
            r.Value = Application.IfError(Application. _
            VLookup(r.Text, Sheets("province").Range("a2:b79"), 2, 0), " ")
            End If
                    Next r
            End With
        End If

[9KiTTi]

ปรับตามนี้ครับ

Code: Select all

Sub paidpro()
    Dim sh As Worksheet
    Dim r As Range
    Application.DisplayAlerts = False
    On Error Resume Next
    For Each sh In Worksheets
        If sh.Index > 3 Then
            With Sheets("province")
              For Each r In sh.Range("d8:d10000")
              If Len(r.Text) < 3 Then
            r.Value = Application.IfError(Application. _
            VLookup(r.Text, Sheets("province").Range("a2:b79"), 2, 0), " ")
            End If
                    Next r
            End With
        End If

ติด error ไม่มี end sub ผมเพิ่มแล้วยังไม่หายครับ

Code: Select all

Sub paidpro()
    Dim sh As Worksheet
    Dim r As Range
    Application.DisplayAlerts = False
    On Error Resume Next
    For Each sh In Worksheets
        If sh.Index > 3 Then
            With Sheets("province")
              For Each r In sh.Range("d8:d10000")
              If Len(r.Text) < 3 Then
            r.Value = Application.IfError(Application. _
            VLookup(r.Text, Sheets("province").Range("a2:b79"), 2, 0), " ")
            End If
                    Next r
            End With
        End If
End Sub

[9KiTTi]

ปรับตามนี้ครับ

Code: Select all

Sub paidpro()
    Dim sh As Worksheet
    Dim r As Range
    Application.DisplayAlerts = False
    On Error Resume Next
    For Each sh In Worksheets
        If sh.Index > 3 Then
            With Sheets("province")
              For Each r In sh.Range("d8:d10000")
              If Len(r.Text) < 3 Then
            r.Value = Application.IfError(Application. _
            VLookup(r.Text, Sheets("province").Range("a2:b79"), 2, 0), " ")
            End If
                    Next r
            End With
        End If

ติด error ไม่มี end sub ผมเพิ่มแล้วยังไม่หายครับ

Code: Select all

Sub paidpro()
    Dim sh As Worksheet
    Dim r As Range
    Application.DisplayAlerts = False
    On Error Resume Next
    For Each sh In Worksheets
        If sh.Index > 3 Then
            With Sheets("province")
              For Each r In sh.Range("d8:d10000")
              If Len(r.Text) < 3 Then
            r.Value = Application.IfError(Application. _
            VLookup(r.Text, Sheets("province").Range("a2:b79"), 2, 0), " ")
            End If
                    Next r
            End With
        End If
End Sub

แก้ไขได้แล้วครับ ขอบพระคุณครับอาจารย์ code ที่แก้ไขครับ

Code: Select all

Sub paidpro()
    Dim sh As Worksheet
    Dim r As Range
    Application.DisplayAlerts = False
    On Error Resume Next
    For Each sh In Worksheets
        If sh.Index > 3 Then
            With Sheets("province")
              For Each r In sh.Range("d8:d10000")
              If Len(r.Text) < 3 Then
            r.Value = Application.IfError(Application. _
            VLookup(r.Text, Sheets("province").Range("a2:b79"), 2, 0), " ")
            End If
            Next r
            End With
        End If
        Next sh
   Application.DisplayAlerts = True
End Sub

[9KiTTi]

ขออนุญาตสอบถามครับ ผมนำไปปรับใช้กับแผ่นงานจริง แต่ไม่สามารถใช้งานได้ ไม่สามารถแทนค่ารหัสในคอลัมม์ Q ของชีท rec1 และ rec2 ด้วยชื่อของหน่วยงานจากชีท hoscode คอลัมม์ B รบกวนขอคำแนะนำด้วยครับ ขอบพระคุณครับ

Code: Select all

Sub paidname()
    Dim sh As Worksheet
    Dim r As Range
    Application.DisplayAlerts = False
    On Error Resume Next
    For Each sh In Worksheets
        If sh.Index > 3 Then
            With Sheets("hoscode")
              For Each r In sh.Range("q10:q10000")
              If Len(r.Text) < 3 Then
            r.Value = Application.IfError(Application. _
            VLookup(r.Text, Sheets("hoscode").Range("a2:b17553"), 2, 0), "ไม่พบข้อมูล")
            End If
            Next r
            End With
        End If
        Next sh
   Application.DisplayAlerts = True
End Sub

[puriwutpokin]

ปรับตามนี้ดูครับ

Code: Select all

Sub paidname()
    Dim sh As Worksheet
    Dim r As Range
    Application.DisplayAlerts = False
    On Error Resume Next
    For Each sh In Worksheets
        If sh.Index > 2 Then
            With Sheets("hoscode")
              For Each r In sh.Range("q10:q10000")
              If Len(r.Text) = 5 Then
            r.Value = Application.IfError(Application. _
            VLookup(r.Text, Sheets("hoscode").Range("a2:b17553"), 2, 0), "ไม่พบข้อมูล")
            End If
            Next r
            End With
        End If
        Next sh
   Application.DisplayAlerts = True
End Sub

[9KiTTi]

ปรับตามนี้ดูครับ

Code: Select all

Sub paidname()
    Dim sh As Worksheet
    Dim r As Range
    Application.DisplayAlerts = False
    On Error Resume Next
    For Each sh In Worksheets
        If sh.Index > 2 Then
            With Sheets("hoscode")
              For Each r In sh.Range("q10:q10000")
              If Len(r.Text) = 5 Then
            r.Value = Application.IfError(Application. _
            VLookup(r.Text, Sheets("hoscode").Range("a2:b17553"), 2, 0), "ไม่พบข้อมูล")
            End If
            Next r
            End With
        End If
        Next sh
   Application.DisplayAlerts = True
End Sub

ใช้งานได้แล้วครับ ขอบพระคุณครับอาจารย์