Copy & Paste ข้อมูลเฉพาะบรรทัดที่มีค่าที่ต้องการ

[napaporn.a]

รบกวนสอบถามค่ะ
หากต้องการเขียน code ที่ copy & Paste เฉพาะบรรทัดที่มีค่าที่ต้องการต้องเขียน code อย่างไรคะ
เช่น มีค่าตามตารางที่ 1.

ตารางที่ 1.
ID Name Position
1111 AAAA Manager
2222 BBBB Manager
3333 CCCC Admin
4444 DDDD Admin
5555 EEEE Admin
6666 FFFF Asst. Manager
7777 GGGG Asst. Manager
8888 HHHH Admin
9999 IIII Admin

ต้องการ copy ข้อมูลของ row ที่มีค่า position เท่ากับ "Manager" และ "Asst. Manager" มาต่อข้อมูลบรรทัดสุดท้าย
ของตารางที่ 1. แล้วเปลี่ยน position เป็น "Head Office" ได้ค่าตามตารางที่ 2.

ID Name Position
1111 AAAA Manager
2222 BBBB Manager
3333 CCCC Admin
4444 DDDD Admin
5555 EEEE Admin
6666 FFFF Asst. Manager
7777 GGGG Asst. Manager
8888 HHHH Admin
9999 IIII Admin
1111 AAAA Head Office
2222 BBBB Head Office
6666 FFFF Head Office
7777 GGGG Head Office

ต้องเขียน code อย่างไรคะ
รบกวนด้วยนะคะ
ขอบคุณค่ะ

[snasui]

ดูตัวอย่าง Code ตามด้านล่างครับ

Code: Select all

Sub PasteData()
Dim r As Range, ra As Range
Set ra = ActiveSheet.Range("C2", _
    ActiveSheet.Range("C2").End(xlDown))
For Each r In ra
    If r = "Manager" Or r = "Asst. Manager" Then
        Range("A2").End(xlDown).Offset(1, 0).Resize(1, 3) _
            = r.Offset(0, -2).Resize(1, 3).Value
        Range("C2").End(xlDown) = "Head Office"
    End If
Next r
End Sub

[napaporn.a]

รบกวนสอบถามเพิ่มเติมค่ะ
Range("A2").End(xlDown).Offset(1, 0).Resize(1, 3) _
= r.Offset(0, -2).Resize(1, 3).Value
หมายความว่าอะไรเหรอคะ รบกวนอธิบายค่ะ อยากเข้าใจ code มากขึ้นค่ะ

[napaporn.a]

และถ้าต้องการเปลี่ยนผลลัพธ์ที่ได้เป็นดังตาราง ต้องแก้ไข code ส่วนไหนคะ
ลองทำดูแล้วแต่ไม่สำเร็จ รบกวนด้วยนะคะ

ID Name Position
1111 AAAA Manager
2222 BBBB Manager
3333 CCCC Admin
4444 DDDD Admin
5555 EEEE Admin
6666 FFFF Asst. Manager
7777 GGGG Asst. Manager
8888 HHHH Admin
9999 IIII Admin
A111 AAAA Head Office
B222 BBBB Head Office
F666 FFFF Head Office
G777 GGGG Head Office

เปลี่ยนตัวแรกของ ID จาก 1 เป็น A จาก 2 เป็น B จาก 6 เป็น F จาก 7 เป็น G ค่ะ

[snasui]

Range("A2").End(xlDown).Offset(1, 0).Resize(1, 3) _
= r.Offset(0, -2).Resize(1, 3).Value
หมายความว่าอะไรเหรอคะ

เป็นการกำหนดค่าให้กับ Range("A2").End(xlDown).Offset(1, 0).Resize(1, 3) ว่าให้มีค่าเท่ากับค่าใน r.Offset(0, -2).Resize(1, 3)

Range("A2").End(xlDown).Offset(1, 0).Resize(1, 3) หมายถึง

จาก Range("A2") ให้ไปยังตัวที่อยู่ด้านล่างสุดในคอลัมน์เดียวกันแล้วเลื่อนจากตัวล่างสุดลงไปอีก 1 เซลล์จากนั้นปรับขนาดเป็นสูง 1 เซลล์ กว้าง 3 เซลล์

และถ้าต้องการเปลี่ยนผลลัพธ์ที่ได้เป็นดังตาราง ต้องแก้ไข code ส่วนไหนคะ
ลองทำดูแล้วแต่ไม่สำเร็จ รบกวนด้วยนะคะ

ID Name Position
...
B222 BBBB Head Office
F666 FFFF Head Office
G777 GGGG Head Office

เปลี่ยนตัวแรกของ ID จาก 1 เป็น A จาก 2 เป็น B จาก 6 เป็น F จาก 7 เป็น G ค่ะ

ลองส่ง Code ที่ลองทำเองแล้วมาดูกันครับ จะได้ปรับต่อไปจากนั้น

[napaporn.a]

ลองเขียนแบบนี้ ได้ผลออกมาแล้วค่ะ
run แล้วรู้สึกว่าช้าๆ ไม่แน่ใจว่าจะมีวิธีที่ทำให้การ run เร็วกว่านี้หรือเปล่าคะ

Sub PasteData()
Dim r As Range, ra As Range

Set ra = ActiveSheet.Range("E20", _
ActiveSheet.Range("E20").End(xlDown))

For Each r In ra

If r = "Manager" Or r = "Asst. Manager" Then
Range("A2").End(xlDown).Offset(1, 0).Resize(1, 3) _
= r.Offset(0, -2).Resize(1, 3).Value
Range("C2").End(xlDown) = "Head Office"

lcode = Left(Range("A2").End(xlDown), 1)
rcode = Right(Range("A2").End(xlDown), 3)

If lcode = "1" Then
Range("A2").End(xlDown) = "A" & rcode
Else
If lcode = "2" Then
Range("A2").End(xlDown) = "B" & rcode
Else
If lcode = "6" Then
Range("A2").End(xlDown) = "F" & rcode
Else
If lcode = "7" Then
Range("A2").End(xlDown) = "G" & rcode
End If
End If
End If
End If
End If
Next r
End Sub
ขอบคุณค่ะ

[snasui]

ลองดู Code ตามด้านล่างครับว่าเร็วกว่าเดิมหรือไม่

Code: Select all

Sub PasteData()
Dim r As Range, ra As Range, s As Range
Set ra = Range("C2", Range("C2").End(xlDown))
For Each r In ra
    If r = "Manager" Or r = "Asst. Manager" Then
        Range("A2").End(xlDown).Offset(1, 0).Resize(1, 3) _
            = r.Offset(0, -2).Resize(1, 3).Value
        Range("C2").End(xlDown) = "Head Office"
        Set s = r.End(xlDown).Offset(0, -2)
        Select Case Left(s, 1)
            Case 1: s = "A" & Right(s, 4)
            Case 2: s = "B" & Right(s, 4)
            Case 6: s = "F" & Right(s, 4)
            Case 7: s = "G" & Right(s, 4)
        End Select
    End If
Next r
End Sub

[napaporn.a]

ขอบคุณนะคะ ทำได้เรียบร้อยแล้วค่ะ