Snasui Excel Forum

Code: Select all

Sub atselect()
Dim itemno As Range
Worksheets("Data").Activate
    For Each itemno In Range("H2:H21")
    itemno.Select
        If ActiveCell = Sheets("Input").Range("A2") Then
            ActiveCell.Offset(0, -6).Value = Sheets("Input").Range("B2")
        Else
            ActiveCell.Offset(0, -6).Value = "NODATA"
        End If
    Next itemno
End Sub

Code: Select all

Sub test()
    Dim iTemNo As Range, rColA As Range, lCount As Long, _
        rHeadNo1 As Range, rHeadNo2 As Range, rFind As Range, r As Range
    Set rHeadNo1 = ActiveSheet.Range("b1:f1")
    Set rHeadNo2 = Sheets("input").Range("b1:e1")
    Set rColA = Sheets("input").Range("a2:a9")
    For Each iTemNo In Range("h2:h21")
        lCount = Application.CountIf(rColA, iTemNo)
        If lCount > 0 Then
            lCount = Application.Match(iTemNo, rColA, 0) + 1
            For Each r In rHeadNo1
                Set rFind = rHeadNo2.Find(what:=r.Value)
                If Not rFind Is Nothing Then
                    r.Offset(iTemNo.Row - r.Row, 0).Value = _
                                rFind.Offset(lCount - 1, 0).Value
                Else
                    r.Offset(iTemNo.Row - r.Row, 0).Value = "NoData"
                End If
            Next r
        End If
    Next iTemNo
End Sub

Code: Select all

If Not rFind Is Nothing Then
                    r.Offset(iTemNo.Row - r.Row, 0).Value = _
                                rFind.Offset(lCount - 1, 0).Value
                Else
                    r.Offset(iTemNo.Row - r.Row, 0).Value = "NoData"
                End If

Code: Select all

Sub test()
    Dim iTemNo As Range, rColA As Range, lCount As Long, _
        rHeadNo1 As Range, rHeadNo2 As Range, rFind As Range, r As Range
     '~~>สร้างตัวแปรช่วงที่สนใจเพื่อเอามาอ้างอิงสะดวกครับ
    Set rHeadNo1 = ActiveSheet.Range("b1:f1")
    Set rHeadNo2 = Sheets("input").Range("b1:e1")
    Set rColA = Sheets("input").Range("a2:a9")
    '~~>เริ่มลูปจากการไล่ช่วง h2:h21 ทีละเซลล์โดยแทนด้วยตัวแปร iTemNo
    For Each iTemNo In Range("h2:h21")
        '~~> นับดูว่า iTemNo มีในช่วง rColA หรือไม่
        lCount = Application.CountIf(rColA, iTemNo)
        '~~> หากมีก็ให้รันคำสั่งต่อไปนี้ จะได้ลดเวลาการรันคำสั่ง
        '~~> ไม่ต้องไล่หาทุกค่าใน h2:h21 ครับ
        If lCount > 0 Then
            '~~> ดูว่าค่า iTemNo อยู่ในบรรทัดไหนใน rColA
            '~~> เพื่อเอามาใช่เลื่อนแกนในคำสั่ง Offset
            lCount = Application.Match(iTemNo, rColA, 0) + 1
            '~~> เริ่มลูปเพื่อตรวจหัวคอลัมน์ จะได้ดึงข้อมูล
            '~~> ในคอลัมน์ชื่อเดียวกันมาใส่ ผมใช้คำสั่ง Find คล้ายๆ กับ
            '~~> การกด ctrl+f ในเวิร์คชีทครับ
            For Each r In rHeadNo1
                Set rFind = rHeadNo2.Find(what:=r.Value)
                '~~> หากพบค่า r ใน rHeadNo2 ก็จะสามารถ
                '~~> เซ็ต rFind ได้ คือมันจะได้เป็น range ใดก็ตาม
                '~~> ใน rHeadNo2 แต่ถ้าหาไม่พบ rFind ก็จะไม่มีอะไรเลย
                '~~> คือ nothing ครับ... If ด้านล่างนี้เป็นปฏิเสธซ้อน
                '~~> ปฏิเสธ "ถ้า rFind ไม่ใช่ Nothing ก็ให้..."
                If Not rFind Is Nothing Then
                     '~~> คำสั่งจากนี้เป็นการเลื่อนแกนด้วย offset
                     '~~> ลองค่อยๆดูครับ ว่าเอาแถวอะไรลบอะไร
                     '~~> และเอาค่าที่ match ที่หาไว้ก่อนหน้านี้มาใช้
                    r.Offset(iTemNo.Row - r.Row, 0).Value = _
                                rFind.Offset(lCount - 1, 0).Value
                Else
                    r.Offset(iTemNo.Row - r.Row, 0).Value = "NoData"
                End If
            Next r
        End If
    Next iTemNo
End Sub

Code: Select all

CODE: SELECT ALL
If Not rFind Is Nothing Then
   r.Offset(iTemNo.Row - r.Row, 0).Value = _
   rFind.Offset(lCount - 1, 0).Value
Else
   r.Offset(iTemNo.Row - r.Row, 0).Value = "NoData"
End If

Code: Select all

r.Offset(iTemNo.Row - r.Row, 0).Value = _
   rFind.Offset(lCount - 1, 0).Value