วิธีเขียนสูตร สร้าง sheet และใส่ข้อมูลตาม ตาราง

[TanabadeeY]

อยากเขียนสูตร VBA ให้สร้าง sheets ที่ที่หน้าตาเหมือน sheets "table" เรื่อยๆตามข้อมูลใน sheets "database"

และเอาข้อมูลจาก Sheets"database" ตามหัวข้อ A B C D ไปใส่แต่ละ cell ที่สร้างขึ้นใหม่ เรื่อยๆ

สรุป จะได้ 6 sheets ที่แต่ละ sheets จะมีชื่อตาม Contract No.

(ข้อมูลของจริงใน sheets "database" จะมีหลายพันบรรทัด นะครับ)

ไฟล์ตัวอย่างผมลองทำตัวอย่างมา 1 sheets นะครับ
ขอบคุณครับ

[logic]

แนบโค้ดที่เขียนมาแล้วในไฟล์ด้วยนะครับ ไฟล์ที่ลงท้ายด้วย .xlsx จะไม่ติดโค้ดมาด้วย ต้องเป็น .xlsm ครับ

[TanabadeeY]

แนบโค้ดที่เขียนมาแล้วในไฟล์ด้วยนะครับ ไฟล์ที่ลงท้ายด้วย .xlsx จะไม่ติดโค้ดมาด้วย ต้องเป็น .xlsm ครับ

ขอโทษครับ ยังไม่เคยเขียน code แนวนี้เลยครับ เริ่มไม่ถูกเลยครับ

[logic]

มีกฎของบอร์ด (ข้อ 5) ว่าให้ผู้ถามเขียนมาก่อนครับ

[TanabadeeY]

มีกฎของบอร์ด (ข้อ 5) ว่าให้ผู้ถามเขียนมาก่อนครับ

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

[logic]

พอจะมีเคสคล้ายๆกันให้ดูเป็นตัวอย่างมั้ยครับ

ข้อ 44 ในลิ้งก์นี้อาจารย์สอนโค้ดแยกข้อมูลออกเป็นหลายชีต ลองดูครับ ~~> viewtopic.php?f=9&t=14822

[TanabadeeY]

พอจะมีเคสคล้ายๆกันให้ดูเป็นตัวอย่างมั้ยครับ

ข้อ 44 ในลิ้งก์นี้อาจารย์สอนโค้ดแยกข้อมูลออกเป็นหลายชีต ลองดูครับ ~~> viewtopic.php?f=9&t=14822

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

[TanabadeeY]

ลองทำมาแล้วครับ แต่รันแล้ว error ไม่ทราบว่าต้องแก้ยังไงครับ ตอน copy sheets"Table" แล้ว error

[puriwutpokin]

ปรับการสร้างชีทตามนี้ครับ

Code: Select all

Sub test()
    Dim r As Range, d As Object, s As Worksheet, a As Range, b As Range
    Set d = CreateObject("scripting.dictionary")
    With Sheets(1)
        For Each r In .Range("b2", .Range("b" & .Rows.Count).End(xlUp))
        If Not d.exists(r.Value) Then
        d.Add r.Value, r.Value
   Sheets(2).Copy After:=Worksheets(Worksheets.Count)
   Set s = Worksheets(Worksheets.Count)
        Sheets(1).Select
        s.Name = r.Value
        s.Range("f1").Value = "CT"
        s.Range("f2").Value = r.Value
    End If
    Next r
    End With
    Application.DisplayAlerts = True
End Sub

[TanabadeeY]

ปรับการสร้างชีทตามนี้ครับ

Code: Select all

Sub test()
    Dim r As Range, d As Object, s As Worksheet, a As Range, b As Range
    Set d = CreateObject("scripting.dictionary")
    With Sheets(1)
        For Each r In .Range("b2", .Range("b" & .Rows.Count).End(xlUp))
        If Not d.exists(r.Value) Then
        d.Add r.Value, r.Value
   Sheets(2).Copy After:=Worksheets(Worksheets.Count)
   Set s = Worksheets(Worksheets.Count)
        Sheets(1).Select
        s.Name = r.Value
        s.Range("f1").Value = "CT"
        s.Range("f2").Value = r.Value
    End If
    Next r
    End With
    Application.DisplayAlerts = True
End Sub

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