วิธีการ รวมข้อมูล หลายชีท ครับ

[ppichimaru]

อยากให้ ตารางในชีท 1 กับ ชีท 2 รวมกัน ไปอยู่ที่ ชีท 3

โดยมีเงื่อนไขว่า
ประมาณว่า ให้เอาคอลัมน์ของแต่ละตารางมาต่อกัน คงไว้แต่ id

หากยังไม่เห็นภาพ เปิดดู ชีท 4 ครับ

เมื่อมีข้อมูลมากๆ จะลากก็อปมาวาง ก็ใช้เวลานาน

สามารถทำ คำสั่ง แมโคร ได้มั้ยครับ
ขอบคุณครับ

[joo]

ลองแบบนี้ดูครับว่าตรงกับที่ต้องการหรือไม่ที่ Sheet3 เซลล์ A2 คีย์
=MATCH(Sheet1!$A2,Sheet1!$A$2:$A$21,0) Enter > Copy ลงล่าง
ที่ B2 คีย์
=INDIRECT("Sheet1!$B$2:$B$21") Enter > Copy ลงล่าง
ที่ C2 คีย์
=INDIRECT("Sheet2!$B$2:$B$21") Enter > Copy ลงล่าง
ที่ D2 คีย์
=INDIRECT("Sheet2!$C$2:$C$21") Enter > Copy ลงล่าง

[ppichimaru]

เดี๋ยว จะลองดู นะครับ

ขอบคุณมากครับ

[ppichimaru]

รบกวน อีก นิดครับ

มี วิธี แบบ สร้างคำสั่ง แมโคร กดรัน แล้วมัน ทำงานออโต้ มั้ยอ่าครับ

แบบไม่ต้อง copy เอง

สมมติ ข้อมูล หมื่นๆ เรคคอร์ด ครับ

[joo]

หากเป็นคำถามที่เกี่ยวกับการใช้ VBA ต้องเขียนมาเองก่อนครับตามกฎข้อที่5 หรือไม่ก็ลองใช้วิธีบันทึก Macro แล้วนำโค๊ดมาปรับใช้ดูครับ

[ppichimaru]

ครับ

ใช้ code ตัวนี้ พอรัน คำสั่งแล้ว

ตารางในชีท 2 ไปต่อท้าย ลงไปด้านล่าง ตารางที่ 1 ในชีท 3

ซึ่ง ไม่เรียงต่อกันแนวนอน

Code: Select all

Sub CollectData()
    Dim ws As Worksheet
    Dim r As Range
    Dim rTarget As Range
    Dim DataAll As String
    DataAll = "Sheet3"
    Application.ScreenUpdating = False
    For Each ws In Worksheets
        If ws.Name <> DataAll Then
            With Sheets(DataAll)
                Set rTarget = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            End With
            Set r = ws.Range("A1", ws.Range("A" & Rows.Count).End(xlUp))
                r.SpecialCells(xlCellTypeConstants).EntireRow.Copy
                rTarget.PasteSpecial xlPasteValues
        End If
    Next ws
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

[tupthai]

ชีท3 เป็นชีทรวมข้อมูล

Code: Select all

Sub CollectData()
    Dim ws As Worksheet
    For Each ws In Worksheets
        If ws.Name <> "Sheet3" Then
             ws.UsedRange.Copy Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
        End If
    Next ws
    Application.CutCopyMode = False
End Sub

[ppichimaru]

ขอบคุณ ท่าน tupthai มากครับ

ใกล้จะ สำเร็จละ ติดตรงที่ว่า มันก๊อป ซ้ำกัน 2 รอบอ่ะครับ

ยังไงรบกวนดู ไฟล์แนบอีกทีนะครับ

ขอบคุณมากครับ

[tupthai]

code ทำการรวมข้อมูลทุกชีท ยกเว้นชีทที่ชื่อ Sheet3 ซึ่งเป็นชีทสรุป
จะใช้ชีทไหนเป็นชีทสรุปก็เปลี่ยน code ตรงนี้
If ws.Name <> "Sheet3" Then

[ppichimaru]

ในตาราง sheet3 ที่รวมออกมา อ่ะครับ

อยากให้มี คอลัมน์ id เพียง คอลัมน์เดียวอ่ะครับ

คือ ประมาณว่า หัวคอลัมน์

| ID | LAB | BP | TEST|

ให้เรียงตามนี้ สามารถ ทำได้มั้ยครับ

ท่าน tubthai

ขอบคุณมากครับ

[joo]

เปลี่ยนโค๊ดที่บรรทัดนี้ครับจาก

Code: Select all

ws.UsedRange.Copy Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)

ปรับเป็น

Code: Select all

ws.UsedRange.Copy Cells(1, Columns.Count).End(xlToLeft).Offset(1, 0)

[ppichimaru]

คอลัมน์ lab จาก sheet1 ไม่มา ครับ

มาแต่ คอลัมน์ bp กับ test จาก sheet 2

[tupthai]

Code: Select all

ws.UsedRange.Resize(ws.UsedRange.Rows().Count, 1).Copy Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)

[ppichimaru]

Code: Select all

ws.UsedRange.Resize(ws.UsedRange.Rows().Count, 1).Copy Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)

ใช้ code นี้ แล้ว มันดึงแต่คอมลัมน์ id มา 2 คอลัมน์ อ่ะครับ

ที่มารวมใน ชีท 3

[tupthai]

ลองดูครับ

Code: Select all

Sub CollectData()
    Dim ws As Worksheet
    Dim source As Range
    Dim target As Range
    For Each ws In Worksheets
        If ws.Name <> "Sheet3" Then
            With ws.UsedRange
                     Set source = .Offset(0, 1).Resize(.Rows.Count)
                     Set target = Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
                     source.Copy target
            End With
        End If
    Next ws
    Application.CutCopyMode = False
End Sub

[ppichimaru]

ลองดูครับ

Code: Select all

Sub CollectData()
    Dim ws As Worksheet
    Dim source As Range
    Dim target As Range
    For Each ws In Worksheets
        If ws.Name <> "Sheet3" Then
            With ws.UsedRange
                     Set source = .Offset(0, 1).Resize(.Rows.Count)
                     Set target = Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
                     source.Copy target
            End With
        End If
    Next ws
    Application.CutCopyMode = False
End Sub

ขอบคุณมากๆครับ ที่ตอบ

สงสัย คงจะหมดหนทางละ

ทีนี้ code นี้ column id ไม่มา นอกนั้น มาครบ เลย จากชีท 1 , 2

ผมไม่มีความรู้ด้าน code vb เลย

สงสัย จะ ทำไม่ได้ละ เฮ้อออ

[tupthai]

ตามที่ให้code ไป เรียงตามลำดับที่ผมตอบไปcode จะทำงานดังนี้ครับ

อันแรก code จะเอามาทุกคอลัมน์
อันสอง code จะเอามาเฉพาะคอลัมน์แรก ซึ่งก็คือ ID
อันสาม code จะเอาทั้งหมดยกเว้น คอลัมน์แรก ซึ่งก็คือ ID

ทีนี้ code นี้ column id ไม่มา นอกนั้น มาครบ เลย จากชีท 1 , 2

ต้องกลับไปเอา code อันแรกมาใช้ครับแบบเอาหมดทุกคอลัมน์เลย