การ search ข้อมูล (vba)

[peam55]

คือผมมี sheet งานอยู่ 2 sheet ใน sheet 1 เป็นตารางข้อมูล ใน sheet ที่ 2 เป็นตารางสำหรับกรอกข้อมูลลงไป ผมอยากกรอกข้อมูลลงใน sheet 2 คอลัมน์ a ที่เดียว 3 อัน แล้ว search ให้มันขึ้นเหมือนตารางในsheet 1 ต้องเขียนโค้ดยังไงครับ
[img]<a%20href="http://pic.free.in.th/id/f96099022bbac4 ... h"%20/></a>[/img]

[joo]

หากต้องการใช้ VBA จำเป็นต้องเขียนมาเองก่อนครับตามกฎข้อที่ 5 ด้านบนครับ

[peam55]

Public Sub search()
Dim stepin As Variant
Dim search_a As Byte
Dim check_a As Byte
Dim search_b As String
Dim check_b As String
Dim b As Variant
Dim c As Variant
Dim d As Variant
Dim e As Variant
Dim f As Variant
Dim g As Variant
Dim h As Variant
Dim i As Variant
Dim z As Integer
Dim data_row As Single
Const b_col = 2
Const a_col = 1
Const c_col = 3
Const d_col = 4
Const e_col = 5
Const f_col = 6
Const g_col = 7
Const h_col = 8
Const i_col = 9

z = 4
data_row = 3
b = Worksheets("sheet1").Cells(data_row, b_col).Value
a = Worksheets("sheet1").Cells(data_row, a_col).Value
c = Worksheets("sheet1").Cells(data_row, c_col).Value
d = Worksheets("sheet1").Cells(data_row, d_col).Value
e = Worksheets("sheet1").Cells(data_row, e_col).Value
f = Worksheets("sheet1").Cells(data_row, f_col).Value
g = Worksheets("sheet1").Cells(data_row, g_col).Value
h = Worksheets("sheet1").Cells(data_row, h_col).Value
i = Worksheets("sheet1").Cells(data_row, i_col).Value
search_a = Worksheets("sheet2").Cells(z, 1).Value
z = z + 1

With Worksheets("sheet1")
Do Until check_a = search_a
data_row = data_row + 1
check_a = Worksheets("sheet1").Cells(data_row, a_col).Value
Loop
End With
z = 4
With Worksheets("sheet2")
.Cells(z, 2).Value = Worksheets("sheet1").Cells(data_row, b_col).Value
.Cells(z, 3).Value = Worksheets("sheet1").Cells(data_row, c_col).Value
.Cells(z, 4).Value = Worksheets("sheet1").Cells(data_row, d_col).Value
.Cells(z, 5).Value = Worksheets("sheet1").Cells(data_row, e_col).Value
.Cells(z, 6).Value = Worksheets("sheet1").Cells(data_row, f_col).Value
.Cells(z, 7).Value = Worksheets("sheet1").Cells(data_row, g_col).Value
.Cells(z, 8).Value = Worksheets("sheet1").Cells(data_row, h_col).Value
.Cells(z, 9).Value = Worksheets("sheet1").Cells(data_row, i_col).Value
End With
z = z + 1
End Sub

อันนี้คือที่ทำไว้ครับ มัน search ได้แค่อันเดียวครับ search ทั้ง 3 อันไม่ได้ ต้องแก้อะไรบ้างครับ

[snasui]

ควรวาง Code ให้แสดงเป็น Code เพื่อจะได้สะดวกในการอ่านและ Copy ไปทดสอบ ดูวิธีการที่นี่ครับ viewtopic.php?f=3&t=1187

สำหรับที่ถามมานั้น ลองดูตัวอย่าง Code ตามด้านล่างครับ

Code: Select all

Sub test()
    Dim tg As Range
    Dim srAll As Range
    Dim tgAll As Range
    Dim m As Long
    With Sheets("Sheet1")
        Set srAll = .Range("a4", .Range("a" & Rows.Count).End(xlUp))
    End With
    
    With Sheets("Sheet2")
        Set tgAll = .Range("a4", .Range("a" & Rows.Count).End(xlUp))
    End With
    
    For Each tg In tgAll
        If Application.CountIf(srAll, tg) > 0 Then
            m = Application.Match(tg, srAll, 0)
            tg.Offset(0, 1).Resize(1, 8).Value = srAll(m).Offset(0, 1).Resize(1, 8).Value
        End If
    Next tg
End Sub

[peam55]

ควรวาง Code ให้แสดงเป็น Code เพื่อจะได้สะดวกในการอ่านและ Copy ไปทดสอบ ดูวิธีการที่นี่ครับ viewtopic.php?f=3&t=1187

สำหรับที่ถามมานั้น ลองดูตัวอย่าง Code ตามด้านล่างครับ

Code: Select all

Sub test()
    Dim tg As Range
    Dim srAll As Range
    Dim tgAll As Range
    Dim m As Long
    With Sheets("Sheet1")
        Set srAll = .Range("a4", .Range("a" & Rows.Count).End(xlUp))
    End With
    
    With Sheets("Sheet2")
        Set tgAll = .Range("a4", .Range("a" & Rows.Count).End(xlUp))
    End With
    
    For Each tg In tgAll
        If Application.CountIf(srAll, tg) > 0 Then
            m = Application.Match(tg, srAll, 0)
            tg.Offset(0, 1).Resize(1, 8).Value = srAll(m).Offset(0, 1).Resize(1, 8).Value
        End If
    Next tg
End Sub

ได้แล้วครับ ขอบคุณมากครับ
รบกวนถามอีกหน่อยครับว่า ถาผมจะให้มันขึ้นแค่บางคอลัมน์ได้ไหมครับ สมมติ search แล้วให้ขึ้นในคอมลัมน์ e,g,i ครับ ที่เหลือไม่ต้องขึ้นอะครับ
แล้วถ้าผมจะใช้คอลัมน์ b search ผมต้องใส่ให้เหมือนใน sheet1 เลยใช่ไหมครับ สมมติผมจะใส่แค่ a ตัวเดียวได้ไหมครับไม่ต้องทั้ง aa
ผมลองๆทำแล้วมันยังไม่ได้อะครับ พอดีเพิ่งมาลองเล่น vba ได้ไม่นานยังงงๆอยู่ครับ ขอรบกวนด้วยครับ

[snasui]

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

สำหรับคำว่า "ครับ" ใช้ตรง ๆ ได้เลยครับ ไม่ควรใช้เป็น "อะครับ" ครับ

[peam55]

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

สำหรับคำว่า "ครับ" ใช้ตรง ๆ ได้เลยครับ ไม่ควรใช้เป็น "อะครับ" ครับ

อาจารย์ครับรบกสนช่วยอธิบาย code นี้ให้ผมที่ครับ ยังไม่ค่อยเข้าใจ

Code: Select all

Sub test()
    Dim tg As Range
    Dim srAll As Range
    Dim tgAll As Range
    Dim m As Long
    With Sheets("Sheet1")
        Set srAll = .Range("a4", .Range("a" & Rows.Count).End(xlUp))
    End With
    
    With Sheets("Sheet2")
        Set tgAll = .Range("a4", .Range("a" & Rows.Count).End(xlUp))
    End With
    
    For Each tg In tgAll
        If Application.CountIf(srAll, tg) > 0 Then
            m = Application.Match(tg, srAll, 0)
            tg.Offset(0, 1).Resize(1, 8).Value = srAll(m).Offset(0, 1).Resize(1, 8).Value
        End If
    Next tg
End Sub

ขอบคุณครับ

[snasui]

ไม่เข้าใจบรรทัดใดบ้าง ให้ยกมาถามเฉพาะบรรทัดนั้นครับ

[peam55]

ไม่เข้าใจบรรทัดใดบ้าง ให้ยกมาถามเฉพาะบรรทัดนั้นครับ

ตรงนี้ครับ

Code: Select all

For Each tg In tgAll
        If Application.CountIf(srAll, tg) > 0 Then
            m = Application.Match(tg, srAll, 0)
            tg.Offset(0, 1).Resize(1, 8).Value = srAll(m).Offset(0, 1).Resize(1, 8).Value
        End If
    Next tg

Code: Select all

        Set srAll = .Range("a4", .Range("a" & Rows.Count).End(xlUp))

        Set tgAll = .Range("a4", .Range("a" & Rows.Count).End(xlUp))

แล้ว sr tg คืออะไรครับ
ขอบคุณครับ

[snasui]

จาก

Set srAll = .Range("a4", .Range("a" & Rows.Count).End(xlUp))

เป็นการกำหนดให้ตัวแปร srAll มีค่าเริ่มจากเซลล์ a4 จนถึงเซลล์ a บรรทัดสุดท้ายที่มีข้อมูล

จาก

For Each tg In tgAll
        If Application.CountIf(srAll, tg) > 0 Then
            m = Application.Match(tg, srAll, 0)
            tg.Offset(0, 1).Resize(1, 8).Value = srAll(m).Offset(0, 1).Resize(1, 8).Value
        End If
    Next tg

เป็นการ Loop ตัวแปร tg ในตัวแปร tgAll ไปทีละค่า

If Application.CountIf(srAll, tg) > 0 Then เป็นการตรวจสอบว่ามีค่า tg อยู่ในตัวแปร srAll หรือไม่

m = Application.Match(tg, srAll, 0) เป็นการกำหนดค่าตัวแปร m ให้มีค่าเท่ากับลำดับที่พบตัวแปร tg ในตัวแปร srAll

tg.Offset(0, 1).Resize(1, 8).Value = srAll(m).Offset(0, 1).Resize(1, 8).Value เป็นการกำหนดให้พื้นที่เซลล์ที่สัมพันธ์กับตัวแปร tg เท่ากับค่าที่สัมพันธ์กับตัวแปร srAll ลำดับที่ m

ค่าที่สัมพันธ์ดังกล่าวคือ ให้ขยับตัวแปร tg ไปด้านขวา 1 คอลัมน์แล้วขยายไปด้านขวา 8 คอลัมน์ เพื่อรองรับข้อมูลต้นทางที่มีขนาดเดียวกัน

.Offset(0, 1) เป็นการขยับไปทางขวา 1 คอลัมน์

.Resize(1, 8) เป็นการขยายไปทางขวา 8 คอลัมน์

[peam55]

จาก

Set srAll = .Range("a4", .Range("a" & Rows.Count).End(xlUp))

เป็นการกำหนดให้ตัวแปร srAll มีค่าเริ่มจากเซลล์ a4 จนถึงเซลล์ a บรรทัดสุดท้ายที่มีข้อมูล

จาก

For Each tg In tgAll
        If Application.CountIf(srAll, tg) > 0 Then
            m = Application.Match(tg, srAll, 0)
            tg.Offset(0, 1).Resize(1, 8).Value = srAll(m).Offset(0, 1).Resize(1, 8).Value
        End If
    Next tg

เป็นการ Loop ตัวแปร tg ในตัวแปร tgAll ไปทีละค่า

If Application.CountIf(srAll, tg) > 0 Then เป็นการตรวจสอบว่ามีค่า tg อยู่ในตัวแปร srAll หรือไม่

m = Application.Match(tg, srAll, 0) เป็นการกำหนดค่าตัวแปร m ให้มีค่าเท่ากับลำดับที่พบตัวแปร tg ในตัวแปร srAll

tg.Offset(0, 1).Resize(1, 8).Value = srAll(m).Offset(0, 1).Resize(1, 8).Value เป็นการกำหนดให้พื้นที่เซลล์ที่สัมพันธ์กับตัวแปร tg เท่ากับค่าที่สัมพันธ์กับตัวแปร srAll ลำดับที่ m

ค่าที่สัมพันธ์ดังกล่าวคือ ให้ขยับตัวแปร tg ไปด้านขวา 1 คอลัมน์แล้วขยายไปด้านขวา 8 คอลัมน์ เพื่อรองรับข้อมูลต้นทางที่มีขนาดเดียวกัน

.Offset(0, 1) เป็นการขยับไปทางขวา 1 คอลัมน์

.Resize(1, 8) เป็นการขยายไปทางขวา 8 คอลัมน์

ขอบคุณครับ