การดึงข้อมูลระหว่าง sheet ตามเงือนไข

[lumi]

รบกวนสอบถามผู้รู้ค่ะ

พอดีต้องการดึงข้อมูลจาก Sheet "Data" Column A มาวางใน Sheet "Existing" Column B โดยมีเงื่อนไข ว่าข้อมูลใน Column E ที่ Sheet "Data"ต้องตรงกับข้อมูลใน Column A Sheet "Existing" โดยค่าใน Column A Sheet "Existing"จะเปลี่ยนไปตามที่กำหนด
ปัญหาคือตอนนี้ทำแล้วค่าที่ได้วางทับกันที่ Cell เดียวหมดเลยไม่เรียงต่อลงมาด้านล่าง เช่น

ต้องการ
Order
200004479
200004316
200004317
200004318
200004319
200004326
200004017

ผล
Order
200004017

ตัวอย่าง Code

Code: Select all

Private Sub Test1_Click()
Dim CCenter As String
Dim rCode, rAll, r, r1 As Range

With Sheets("Existing")
    Set rAll = .Range("a:a").SpecialCells(xlCellTypeConstants)
    CCenter = .Range("A1")
End With

For Each r In rAll
    With Sheets("data")
            Set rCode = .Range("e:e").SpecialCells(xlCellTypeConstants)
        For Each r1 In rCode
                If r1.Value = CCenter Then
                    r.Offset(3, 1) = r1.Offset(, -4)
                End If
        Next r1
    End With
Next r
End Sub

[puriwutpokin]

รบกวนสอบถามผู้รู้ค่ะ

พอดีต้องการดึงข้อมูลจาก Sheet "Data" Column A มาวางใน Sheet "Existing" Column B โดยมีเงื่อนไข ว่าข้อมูลใน Column E ที่ Sheet "Data"ต้องตรงกับข้อมูลใน Column A Sheet "Existing" โดยค่าใน Column A Sheet "Existing"จะเปลี่ยนไปตามที่กำหนด
ปัญหาคือตอนนี้ทำแล้วค่าที่ได้วางทับกันที่ Cell เดียวหมดเลยไม่เรียงต่อลงมาด้านล่าง เช่น

ต้องการ
Order
200004479
200004316
200004317
200004318
200004319
200004326
200004017

ผล
Order
200004017

ตัวอย่าง Code

Code: Select all

Private Sub Test1_Click()
Dim CCenter As String
Dim rCode, rAll, r, r1 As Range

With Sheets("Existing")
    Set rAll = .Range("a:a").SpecialCells(xlCellTypeConstants)
    CCenter = .Range("A1")
End With

For Each r In rAll
    With Sheets("data")
            Set rCode = .Range("e:e").SpecialCells(xlCellTypeConstants)
        For Each r1 In rCode
                If r1.Value = CCenter Then
                    r.Offset(3, 1) = r1.Offset(, -4)
                End If
        Next r1
    End With
Next r
End Sub

ปรับโค้ดเป็น

Code: Select all

Dim CCenter As String
Dim rCode, rAll, r, r1 As Range
With Sheets("Existing")
    Set rAll = .Range("a:a").SpecialCells(xlCellTypeConstants)
    CCenter = .Range("A1")
End With
For Each r In rAll
    With Sheets("data")
            Set rCode = .Range("e:e").SpecialCells(xlCellTypeConstants)
        For Each r1 In rCode
                If r1.Value = CCenter Then
                r1.Offset(, -4).Copy
                     Sheets("Existing").Range("b" & Rows.Count) _
        .End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
                    'r.Offset(3, 1) = r1.Offset(, -4)
                End If
        Next r1
    End With
Next r