ปัญหาการใช้ Code offset เพื่อนำข้อมูลไปต่อท้ายตาราง

[sakajohn]

ขอสอบถามครับ ผมใช้คำสั่ง offset เพื่อนำข้อมูลไปต่อท้ายตาราง ตอนแรกใช้งานได้ดี พอข้อมูลเยอะขึ้น ประมาณ6000ข้อมูล การทำงานช้ามากต้องรอนานหลายนาทีกว่าจะจัดการเสร็จ ผมควจะแก้ไขสูตรอย่างไรดีตรับ พอดีไม่ได้ส่งไฟล์มาให้ทดลองครับ เพราะไฟล์ใหญ่มาก

Code: Select all

Private Sub cmdSave_Click()
Dim rg As Range

Set rg = Range("C3")

rg.Activate
If rg.Value = "" Then
MsgBox "ใส่ข้อมูลให้ครบ", vbCritical
    Exit Sub
End If
If isDuplicate(rg.Value) Then
    MsgBox "ข้อมูลซ๊ำ", vbCritical
    Exit Sub
End If

With Workbooks("Dataapp.xlsx").Worksheets("Data")
    With .Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        .Offset(0, 0).Value = rg.Offset(0, 0).Value 'จินเม่าโค๊ด
        .Offset(0, 1).Value = rg.Offset(0, 4).Value
        .Offset(0, 2).Value = rg.Offset(0, 8).Value
        .Offset(0, 3).Value = rg.Offset(2, 0).Value
        .Offset(0, 4).Value = rg.Offset(2, 4).Value
        .Offset(0, 5).Value = rg.Offset(2, 8).Value
        .Offset(0, 6).Value = rg.Offset(2, 10).Value
        .Offset(0, 7).Value = rg.Offset(4, 0).Value
        .Offset(0, 8).Value = rg.Offset(4, 4).Value
        .Offset(0, 9).Value = rg.Offset(6, 0).Value
        .Offset(0, 10).Value = rg.Offset(6, 4).Value
        .Offset(0, 11).Value = rg.Offset(8, 0).Value
        .Offset(0, 12).Value = rg.Offset(8, 4).Value
        .Offset(0, 13).Value = rg.Offset(10, 0).Value
        .Offset(0, 14).Value = rg.Offset(10, 4).Value
        .Offset(0, 15).Value = rg.Offset(12, 0).Value
        .Offset(0, 16).Value = rg.Offset(12, 4).Value
        .Offset(0, 17).Value = rg.Offset(4, 8).Value
        .Offset(0, 18).Value = rg.Offset(6, 8).Value
        .Offset(0, 19).Value = rg.Offset(22, 4).Value
        .Offset(0, 20).Value = rg.Offset(14, 0).Value
        .Offset(0, 21).Value = rg.Offset(14, 4).Value
        .Offset(0, 22).Value = rg.Offset(8, 8).Value
        .Offset(0, 23).Value = rg.Offset(16, 0).Value
        .Offset(0, 24).Value = rg.Offset(18, 0).Value
        .Offset(0, 25).Value = rg.Offset(20, 0).Value
        .Offset(0, 26).Value = rg.Offset(22, 0).Value
        .Offset(0, 27).Value = rg.Offset(24, 0).Value
        .Offset(0, 28).Value = rg.Offset(16, 4).Value
        .Offset(0, 29).Value = rg.Offset(10, 8).Value
        .Offset(0, 30).Value = rg.Offset(12, 8).Value
        .Offset(0, 31).Value = rg.Offset(24, 4).Value
        .Offset(0, 32).Value = rg.Offset(18, 4).Value
        .Offset(0, 33).Value = rg.Offset(20, 4).Value
        .Offset(0, 34).Value = rg.Offset(14, 8).Value
        .Offset(0, 35).Value = rg.Offset(26, 0).Value
        .Offset(0, 36).Value = rg.Offset(16, 8).Value ' remark2
        .Offset(0, 37).Value = rg.Offset(18, 8).Value ' รายละเอียดเพิ่มเติม
        .Offset(0, 38).Value = rg.Offset(20, 8).Value
        .Offset(0, 39).Value = rg.Offset(22, 8).Value
        .Offset(0, 40).Value = rg.Offset(24, 8).Value
        .Offset(0, 41).Value = rg.Offset(17, 0).Value ' ส่วนผสมสี
        .Offset(0, 42).Value = rg.Offset(19, 0).Value ' ส่วนผสมสี
        .Offset(0, 43).Value = rg.Offset(21, 0).Value
        .Offset(0, 44).Value = rg.Offset(23, 0).Value
        .Offset(0, 45).Value = rg.Offset(25, 0).Value
        .Offset(0, 46).Value = rg.Offset(27, 0).Value
        .Offset(0, 47).Value = rg.Offset(26, 8).Value
        
    End With
End With
Range("c3,c5,c7,c9,c11,c13,c15,c17,c19,c20,c21,c22,c23,c24,c25,c26,c27,c28,c29,c30,g3,g5,g7,g9,g11,g13,g15,g17,g19,g21,g23,g25,g27,k3,k5,k7,k9,k11,k13,k15,k17,K19,k21,k23,k25,k27,K29,m5").Select
        Application.CutCopyMode = False
        MsgBox "จัดเก็บข้อมูลเรียบร้อยแล้ว"
        Selection.ClearContents
        Range("c3").Select
        Workbooks("Dataapp.xlsx").Activate
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Workbooks.Open "D:\app\Dataapp.xlsx"
    ThisWorkbook.Activate
End Sub

ผมได้ทดลองแก้ไข Code ใหม่แต่ก็ยังช้าอยู่ดีครับ

Code: Select all

Private Sub cmdSave1_Click()
    Dim InputRange As Range, Target As Range
    Application.EnableEvents = False
    Set InputRange = Range("c3,G3,K3,c5,g5,k5,m5,c7,g7,c9,g9,c11,g11,c13,g13,c15,g15,k7,k9,g25,c17,g17,k11,c19,c21,c23,c25,c27,g19,k13,k15,g27,g21,g23,k17,c29,k19,k21,k23,k25,k27,c20,c22,c24,c26,c28,c30,k29")
     Set Target = Workbooks("Dataapp.xlsx").Worksheets([A32].Value).Range("A" & Rows.Count).End(xlUp)
    For Each cll In InputRange
        Target.Offset(1, C).Value = cll.Value
        C = C + 1
    Next
    Application.EnableEvents = True
     Workbooks("Dataapp.xlsx").Worksheets("Data").Range("A2:AV15000").Value = _
        Workbooks("Dataapp.xlsx").Worksheets("Data").Range("A2:AV15000").Value
    
    Workbooks("Dataapp.xlsx").Close True
       Workbooks.Open "D:\app\Dataapp.xlsx"
       ThisWorkbook.Activate
    Range("c3,c5,c7,c9,c11,c13,c15,c17,c19,c20,c21,c22,c23,c24,c25,c26,c27,c28,c29,c30,g3,g5,g7,g9,g11,g13,g15,g17,g19,g21,g23,g25,g27,k3,k5,k7,k9,k11,k13,k15,k17,K19,k21,k23,k25,k27,K29,m5").Select
    MsgBox "จัดเก็บข้อมูลเรียบร้อยแล้ว"
    Selection.ClearContents
    Range("C3").Select
    ThisWorkbook.Save
End Sub

[snasui]

ตัดไฟล์มาเฉพาะพอเป็นตัวอย่าง จะได้สะดวกในการตรวจสอบครับ

[sakajohn]

ไฟล์แนบครับ ปกติจะอยู่ที่ D:\APP ทั้ง 2 ไฟล์ครับ ถ้าผมอยากจะเพิ่มเติมไม่ให้ คีย์ข้อมูลตรง CODE ห้ามซ้ำกันจะต้องเพิ่มอะไรครับ

[snasui]

ทีผมทดลองไม่พบว่าช้าครับ

ไม่ทราบว่าช้าที่ปุ่มไหน อย่างไร

สำหรับ Code การตรวจสอบว่ามี Code อยู่แล้วหรือไม่สามารถปรับเป็นด้านล่างครับ

Code: Select all

Private Function isDuplicate(C) As Boolean
    Dim rg As Range
    Set rg = Workbooks("Dataapp.xlsx").Worksheets("Data").Range("A:A")
    If Application.CountIf(rg, C) = 0 Then 'rg.Find(C, LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then
        isDuplicate = False
    Else
        isDuplicate = True
    End If
End Function

[sakajohn]

พอมีข้อมูลในตาราง Dataapp ประมาณ 5000 - 6000 ข้อมูล จะบันทึกช้ามากครับ พอกดปุ่มบันทึกข้อมูล CmdSave จะใช้เวลาประมาณ 1 นาทีครับกว่าจะบันทึกข้อมูลสำเร็จ

[snasui]

ลักษณะการแสดงผลเช่นนั้นแสดงว่ามีการคำนวณเกิดขึ้น ไม่ทราบว่ามีสูตรอะไร อยู่ที่ไหน ปริมาณเท่าใด หากไม่มีสูตรไม่ควรจะเกิดการคำนวณลักษณะนั้นครับ

ลองปิดการคำนวณด้วย Code เสียก่อนเสียก่อน เมื่อคำนวณเสร็จค่อยเปิดกลับมาใหม่

ตัวอย่าง Code ครับ

Code: Select all

Application.Calculation = xlCalculationManual
'...Your code
Application.Calculation = xlCalculationAutoMatic

[sakajohn]

จริงๆแล้วไม่มีการคำนวณอะไรเลยนะครับ เป็นแค่การนำข้อมูลไปใส่ในตาราง แล้วก็มีการดึงข้อมูลจากตารางมาใส่ในฟอร์ม ใช้ vlookup แล้วก็สั่งพิมพ์ครับ

[sakajohn]

ตอนนี้ลองใช้สูตของอาจารย์ เร็วมากแล้วครับ แต่พอข้อมูลบันทึกแล้วเหมือน มีการคำนวณต่ออีกครับ แต่ไม่นาน ผมไม่เข้าใจว่ามีการคำนวณอะไร ถ้าเราจะไม่ให้คำนวณ ก็แค่ไม่ต้องเพิ่ม Code บรรทัดสุดท้ายใช่มั้ยครับ

Code: Select all

Application.Calculation = xlCalculationManual
'...Your code
end

[sakajohn]

รบกวนสอบถามอีกข้อครับ ถ้าเราจะกำหนดว่า ถ้าใส่ code ที่มีอยู่แล้วซ้ำ ให้ไปบันทึกซ้ำข้อมูลเดิมที่มีอยู่แล้วได้มั้ยครับ เผื่อกรณีที่มีการแก้ไขข้อมูลครับ เราจะเขียน Code อย่างไรครับ

[snasui]

ตอนนี้ลองใช้สูตของอาจารย์ เร็วมากแล้วครับ แต่พอข้อมูลบันทึกแล้วเหมือน มีการคำนวณต่ออีกครับ แต่ไม่นาน ผมไม่เข้าใจว่ามีการคำนวณอะไร ถ้าเราจะไม่ให้คำนวณ ก็แค่ไม่ต้องเพิ่ม Code บรรทัดสุดท้ายใช่มั้ยครับ

Code: Select all

Application.Calculation = xlCalculationManual
'...Your code
end

จะไม่เพิ่มบรรทัดสุดท้ายได้ก็ต้องมั่นใจว่าเราจะไม่มีสูตร ถ้ามีสูตรมันจะไม่คำนวณอัตโนมัติ ครับ

[snasui]

รบกวนสอบถามอีกข้อครับ ถ้าเราจะกำหนดว่า ถ้าใส่ code ที่มีอยู่แล้วซ้ำ ให้ไปบันทึกซ้ำข้อมูลเดิมที่มีอยู่แล้วได้มั้ยครับ เผื่อกรณีที่มีการแก้ไขข้อมูลครับ เราจะเขียน Code อย่างไรครับ

ในฟอรัมนี้มี Code แบบนี้อยู่พอสมควร ลองศึกษาและเขียนม่เองก่อนครับ