ปัญหาการใช้งาน Macro ใน Excel

[chanakan Cherdchoo]

สวัสดีค่ะ มีปัญหาอยากปรึกษาเกี่ยวกับการใช้ Macro ใน Excel ค่ะ เป็นการเขียนสูตรเกี่ยวกับการส่งข้อมูลข้าม Sheet ก่อนหน้านี้มีการเขียนสูตรอีกแบบหนึ่งแล้วเกิดปัญหาว่า Copy มาไม่ครบบ้าง หายไปบางช่องบ้าง เลยปรับโค้ดให้สั้นลงแล้วแต่ยังไม่หายเลยค่ะ เลยอยากสอบถามว่าสเปคคอมมีผลต่อการใช้งาน Macro ไหมคะ

[snasui]

Spec Computer มีผลต่อการทำงานช้าหรือเร็วเท่านั้น แต่ไม่มีผลต่อความแม่นยำครับ

ความถูกต้องแม่นยำจะขึ้นกับ Version ของโปรแกรม หาก Version ต่างกันบางคำสั่งมีโอกาสจะให้ผลไม่เหมือนกันได้ แต่ก็เป็นส่วนน้อย เช่นเรื่องของการ Filter เรื่องการ Sort เนื่องจาก Version หลัง ๆ มีการ Sort มีการ Filter ได้หลายชั้นกว่า Version ก่อนหน้า เช่นนี้เป็นต้นครับ

[chanakan Cherdchoo]

คิดว่าข้อสันนิษฐานน่าจะเกิดจากสาเหตุอะไรคะ เพราะเป็นแค่บางครั้งค่ะ ประมาณ 20% ค่ะ ที่เหลือจะปกติทำงานตาม Code ที่เขียนเลยค่ะ

[snasui]

ข้อสันนิษฐานคือปัญหาจาก Code ที่เขียน จะทราบข้อเท็จจริงได้ก็ต่อเมื่อเห็นและได้ทดสอบการทำงานของ Code ครับ

[chanakan Cherdchoo]

https://drive.google.com/file/d/1NbksmB ... sp=sharing

ขอนุญาติแนบเป็นลิงค์นะคะ พอดีไฟล์ใหญ่เกินแนบไฟล์ค่ะ ลอง Zip แล้วก็ยังแนบไฟล์ไม่ได้ค่ะ รบกวนอาจารย์ช่วยตรวจสอบ Code ทีนะคะ

[snasui]

กรุณาแจ้งชื่อ Module, ชื่อ Procedure พร้อมแจ้งคำตอบที่ต้องการหาก Code ทำงานถูกต้อง จะได้เข้าถึงปัญหาโดยเร็วครับ

ด้านล่างนี้ได้ปรับขนาดไฟล์ให้เล็กลงแล้วครับ

[chanakan Cherdchoo]

Module1 ค่ะ ชื่อ Macro คือ SaveM1_Click()
โดยคำสั่งที่เขียนจะเป็นการเช็คช่องที่กรอกข้อมูลใน Sheet M1 ให้ครบถ้วน หากไม่ครบจะไม่ดำเนินการต่อค่ะ ให้แจ้ง ฟ้องกล่องข้อความออกมาค่ะ โดยข้อมูลหากกรอกครบถ้วนแล้วจะให้ไปบันทึกที่ Sheet Add&out+PCR+Mortalityinmating , Feed+VCP+Formalin+Salt ,Gravid+Spawning+Abort+Return และ water+Temp+DOC ตามคอลัมน์ชื่อที่ตรงกับข้อมูลค่ะ และก็บันทึกไปที่ ReportM1 ด้วยค่ะ ในช่องที่ตรงกับหัวข้อด้านบนของ Sheet M1 ค่ะ

[snasui]

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

[chanakan Cherdchoo]

ใส่ข้อมูลลงใน Sheet M1 เรียบร้อยแล้วค่ะ

[snasui]

ตัวอย่างการปรับ Code เพื่อตรวจสอบว่าไม่มีเซลล์ว่างแล้วค่อยทำงาน และตัวอย่างการ Loop เพื่อนำไปวางในชีต ReportM1 ตามด้านล่างครับ

Code: Select all

Dim x As Range
Dim answer As VbMsgBoxResult
answer = MsgBox("¤Ø³µéͧ¡Òúѹ·Ö¡¢éÍÁÙÅãªèËÃ×ÍäÁè", vbYesNo, "ºÑ¹·Ö¡¢éÍÁÙÅ")
If answer = vbYes Then
    On Error Resume Next
    Set x = Range("f9:ab18").SpecialCells(xlCellTypeBlanks)
    'If Range("F9").Value = "" Or Range("F10").Value = "" Or Range("F11").Value = "" Or Range("F12") = "" Or Range("F13") = "" Or Range("F14") = "" Or Range("F14") = "" Or Range("F15") = "" Or Range("F16") = "" Or Range("F17") = "" Or Range("F18") = "" Or Range("G9").Value = "" Or Range("G10").Value = "" Or Range("G11").Value = "" Or Range("G12") = "" Or Range("G13") = "" Or Range("G14") = "" Or Range("G14") = "" Or Range("G15") = "" Or Range("G16") = "" Or Range("G17") = "" Or Range("G18") = "" _
    'Or Range("H9") = "" Or Range("H10") = "" Or Range("H11") = "" Or Range("H12") = "" Or Range("H13") = "" Or Range("H14") = "" Or Range("H15") = "" Or Range("H16") = "" Or Range("H17") = "" Or Range("H18") = "" Or Range("I9") = "" Or Range("I10") = "" Or Range("I11") = "" Or Range("I12") = "" Or Range("I13") = "" Or Range("I14") = "" Or Range("I15") = "" Or Range("I16") = "" Or Range("I17") = "" Or Range("I18") = "" _
    'Or Range("J9") = "" Or Range("J10") = "" Or Range("J11") = "" Or Range("J12") = "" Or Range("J13") = "" Or Range("J14") = "" Or Range("J15") = "" Or Range("J16") = "" Or Range("J17") = "" Or Range("J18") = "" Or Range("K9") = "" Or Range("k10") = "" Or Range("K11") = "" Or Range("K12") = "" Or Range("K13") = "" Or Range("K14") = "" Or Range("K15") = "" Or Range("K16") = "" Or Range("K17") = "" Or Range("K18") = "" _
    'Or Range("L9") = "" Or Range("L10") = "" Or Range("L11") = "" Or Range("L12") = "" Or Range("L13") = "" Or Range("L14") = "" Or Range("L15") = "" Or Range("L16") = "" Or Range("L17") = "" Or Range("L18") = "" Or Range("M9") = "" Or Range("M10") = "" Or Range("M11") = "" Or Range("M12") = "" Or Range("M13") = "" Or Range("M14") = "" Or Range("M15") = "" Or Range("M16") = "" Or Range("M17") = "" Or Range("M18") = "" Or Range("C7") = "" _
    'Or Range("N9") = "" Or Range("N10") = "" Or Range("N11") = "" Or Range("N12") = "" Or Range("N13") = "" Or Range("N14") = "" Or Range("N15") = "" Or Range("N16") = "" Or Range("N17") = "" Or Range("N18") = "" Or Range("O9") = "" Or Range("O10") = "" Or Range("O11") = "" Or Range("O12") = "" Or Range("O13") = "" Or Range("O14") = "" Or Range("O15") = "" Or Range("O16") = "" Or Range("O17") = "" Or Range("O18") = "" _
    'Or Range("P9") = "" Or Range("P10") = "" Or Range("P11") = "" Or Range("P12") = "" Or Range("P13") = "" Or Range("P14") = "" Or Range("P15") = "" Or Range("P16") = "" Or Range("P17") = "" Or Range("P18") = "" Or Range("Q9") = "" Or Range("Q10") = "" Or Range("Q11") = "" Or Range("Q12") = "" Or Range("Q13") = "" Or Range("Q14") = "" Or Range("Q15") = "" Or Range("Q16") = "" Or Range("Q17") = "" Or Range("Q18") = "" _
    'Or Range("R9") = "" Or Range("R10") = "" Or Range("R11") = "" Or Range("R12") = "" Or Range("R13") = "" Or Range("R14") = "" Or Range("R15") = "" Or Range("R16") = "" Or Range("R17") = "" Or Range("R18") = "" Or Range("S9") = "" Or Range("S10") = "" Or Range("S11") = "" Or Range("S12") = "" Or Range("S13") = "" Or Range("S14") = "" Or Range("S15") = "" Or Range("S16") = "" Or Range("S17") = "" Or Range("S18") = "" Or Range("T9") = "" Or Range("T10") = "" Or Range("T11") = "" Or Range("T12") = "" Or Range("T13") = "" Or Range("T14") = "" Or Range("T15") = "" Or Range("T16") = "" Or Range("T17") = "" Or Range("T18") = "" _
    'Or Range("U9") = "" Or Range("U10") = "" Or Range("U11") = "" Or Range("U12") = "" Or Range("U13") = "" Or Range("U14") = "" Or Range("U15") = "" Or Range("U16") = "" Or Range("U17") = "" Or Range("U18") = "" Or Range("V9") = "" Or Range("V10") = "" Or Range("V11") = "" Or Range("V12") = "" Or Range("V13") = "" Or Range("V14") = "" Or Range("V15") = "" Or Range("V16") = "" Or Range("V17") = "" Or Range("V18") = "" _
    'Or Range("W8") = "" Or Range("W9") = "" Or Range("W10") = "" Or Range("W11") = "" Or Range("W12") = "" Or Range("W13") = "" Or Range("W14") = "" Or Range("W15") = "" Or Range("W16") = "" Or Range("W17") = "" Or Range("W18") = "" Or Range("X8") = "" Or Range("X9") = "" Or Range("X10") = "" Or Range("X11") = "" Or Range("X12") = "" Or Range("X13") = "" Or Range("X14") = "" Or Range("X15") = "" Or Range("X16") = "" Or Range("X17") = "" Or Range("X18") = "" Or Range("Y8") = "" Or Range("Y9") = "" Or Range("Y10") = "" Or Range("Y11") = "" Or Range("Y12") = "" Or Range("Y13") = "" Or Range("Y14") = "" Or Range("Y15") = "" Or Range("Y16") = "" Or Range("Y17") = "" Or Range("Y18") = "" _
    'Or Range("Z9") = "" Or Range("Z10") = "" Or Range("Z11") = "" Or Range("Z12") = "" Or Range("Z13") = "" Or Range("Z14") = "" Or Range("Z15") = "" Or Range("Z16") = "" Or Range("Z17") = "" Or Range("Z18") = "" Or Range("AA9") = "" Or Range("AA10") = "" Or Range("AA11") = "" Or Range("AA12") = "" Or Range("AA13") = "" Or Range("AA14") = "" Or Range("AA15") = "" Or Range("AA16") = "" Or Range("AA17") = "" Or Range("AA18") = "" _
    'Or Range("AB9") = "" Or Range("AB10") = "" Or Range("AB11") = "" Or Range("AB12") = "" Or Range("AB13") = "" Or Range("AB14") = "" Or Range("AB15") = "" Or Range("AB16") = "" Or Range("AB17") = "" Or Range("AB18") = "" Then
    On Error GoTo 0
    If Not x Is Nothing Then
        MsgBox "â»Ã´ÃкآéÍÁÙÅãËé¤Ãº¶éǹ", vbCritical + vbOKOnly, "á¨é§àµ×͹"
        Exit Sub
    End If
Else
    Exit Sub
End If
Dim mylastrow As Long
With Worksheets("M1")
    mylastrow = Sheets("Add&out+PCR+Mortalityinmating").Range("A" & Rows.Count).End(xlUp).Row + 1
    .Range("B9:M18").Copy
    Sheets("Add&out+PCR+Mortalityinmating").Range("A" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
'    mylastrow = Sheets("Add&out+PCR+Mortalityinmating").Range("M" & Rows.Count).End(xlUp).Row + 1
    .Range("AB9:AB18").Copy
    Sheets("Add&out+PCR+Mortalityinmating").Range("M" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False

    mylastrow = Sheets("Feed+VCP+Formalin+Salt").Range("A" & Rows.Count).End(xlUp).Row + 1
    .Range("B9:E18").Copy
    Sheets("Feed+VCP+Formalin+Salt").Range("A" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
'        mylastrow = Sheets("Feed+VCP+Formalin+Salt").Range("E" & Rows.Count).End(xlUp).Row + 1
    .Range("N9:R18").Copy
    Sheets("Feed+VCP+Formalin+Salt").Range("E" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
'        mylastrow = Sheets("Feed+VCP+Formalin+Salt").Range("J" & Rows.Count).End(xlUp).Row + 1
    .Range("AB9:AB18").Copy
    Sheets("Feed+VCP+Formalin+Salt").Range("J" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
       
    mylastrow = Sheets("Gravid+Spawning+Abort+Return ").Range("A" & Rows.Count).End(xlUp).Row + 1
    .Range("B9:E18").Copy
    Sheets("Gravid+Spawning+Abort+Return ").Range("A" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
'        mylastrow = Sheets("Gravid+Spawning+Abort+Return ").Range("E" & Rows.Count).End(xlUp).Row + 1
    .Range("S9:V18").Copy
    Sheets("Gravid+Spawning+Abort+Return ").Range("E" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
'        mylastrow = Sheets("Gravid+Spawning+Abort+Return ").Range("I" & Rows.Count).End(xlUp).Row + 1
    .Range("AB9:AB18").Copy
    Sheets("Gravid+Spawning+Abort+Return ").Range("I" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False

    mylastrow = Sheets("water+Temp+DOC").Range("A" & Rows.Count).End(xlUp).Row + 1
    .Range("B9:E18").Copy
    Sheets("water+Temp+DOC").Range("A" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
'        mylastrow = Sheets("water+Temp+DOC").Range("E" & Rows.Count).End(xlUp).Row + 1
    .Range("W9:AA18").Copy
    Sheets("water+Temp+DOC").Range("E" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
'        mylastrow = Sheets("water+Temp+DOC").Range("J" & Rows.Count).End(xlUp).Row + 1
    .Range("AB9:AB18").Copy
    Sheets("water+Temp+DOC").Range("J" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
    'Other code
End With
Dim lstRng As Range
Dim rng As Range, j As Integer
Dim r As Range
'    mylastrow = Sheets("reportM1").Range("M" & Rows.Count).End(xlUp).Row + 1
With Sheets("M1")
    With Sheets("ReportM1")
        Set lstRng = .Cells(8, .Columns.Count).End(xlToLeft).Offset(0, 1)
    End With
    j = 1
    For Each r In .Range("J9").Resize(10)
        lstRng.Offset(j, 0).Value = r.Value
        j = j + 2
    Next r
End With
'Other code

[chanakan Cherdchoo]

ถ้าต้องการให้ข้อมูลจาก Sheet M1 ช่อง K9:K18 copy ไปไว้ในช่อง O8 ของ Sheet ReportM1 เว้นทีละช่อง
Sheet M1 ช่อง J9:J18 copy ไปไว้ในช่อง O9 ของ Sheet ReportM1 เว้นทีละช่อง
Sheet M1 ช่อง M9:M18 copy ไปไว้ในช่อง P8 ของ Sheet ReportM1 เว้นทีละช่อง
Sheet M1 ช่อง L9:L18 copy ไปไว้ในช่อง P9 ของ Sheet ReportM1 เว้นทีละช่อง
สูตรที่อาจารย์ลองเขียนเป็นตัวอย่างพอกรอกข้อมูลครั้งถัดไปมันทับที่เดิมค่ะ ต้องการให้ข้อมูลใหม่ต่อกันไปทางด้านขวาค่ะ

[snasui]

ปรับปรุงไฟล์ตาม Code ที่ให้ไปแล้วแนบไฟล์มาใหม่จะได้ตอบต่อไปจากนั้นครับ

[chanakan Cherdchoo]

ใส่ Code เข้าไปแล้วค่ะ ใน Module17

[snasui]

Sheet M1 ช่อง M9:M18 copy ไปไว้ในช่อง P8 ของ Sheet ReportM1 เว้นทีละช่อง
Sheet M1 ช่อง L9:L18 copy ไปไว้ในช่อง P9 ของ Sheet ReportM1 เว้นทีละช่อง

ไม่พบว่ามีการเขียน Code เข้ามาเองตามตัวอย่างที่ให้ไป กรุณาเขียนมาเองก่อน ติดตรงไหนค่อยถามกันต่อครับ

[chanakan Cherdchoo]

ลองเขียนมาเรียบร้อยแล้วค่ะอาจารย์ รบกวนอาจารย์ช่วยตรวจสอบความถูกต้องหรือว่าสามารถเขียนให้โค้ดมีความสั้นลง กระชับมากขึ้นได้ไหมคะ

[snasui]

ที่เขียนมาเองแล้วนั้นผิดพลาดตรงไหนอย่างไร หากทำงานถูกต้องก็ใช้งานได้ครับ

ตัวอย่างการ Loop อีกแบบ ตามด้านล่างครับ

Code: Select all

Dim lstRng As Range
Dim rng As Range, j As Integer
Dim r As Range, c As Integer
With Sheets("M1")
    With Sheets("ReportM1")
        Set lstRng = .Cells(8, .Columns.Count).End(xlToLeft).Offset(0, 1)
    End With
    j = 1 'Paste on row 9
    c = 0
    For Each r In .Range("J9, l9")
        For Each rng In r.Resize(10)
            lstRng.Offset(j, c).Value = rng.Value
            j = j + 2
        Next rng
        j = 1
        c = c + 1
    Next r
     
    j = 0 'Paste in row 8
    c = 0
    For Each r In .Range("K9, M9")
        For Each rng In r.Resize(10)
            lstRng.Offset(j, c).Value = rng.Value
            j = j + 2
        Next rng
        j = 0
        c = c + 1
    Next r
End With

[chanakan Cherdchoo]

Code: Select all

Sub SaveM1_Click()
Dim x As Range
Dim answer As VbMsgBoxResult
answer = MsgBox("¤Ø³µéͧ¡Òúѹ·Ö¡¢éÍÁÙÅãªèËÃ×ÍäÁè", vbYesNo, "ºÑ¹·Ö¡¢éÍÁÙÅ")
If answer = vbYes Then
    On Error Resume Next
    Set x = Range("f9:ab18", "c7").SpecialCells(xlCellTypeBlanks)
       On Error GoTo 0
    If Not x Is Nothing Then
        MsgBox "â»Ã´ÃкآéÍÁÙÅãËé¤Ãº¶éǹ", vbCritical + vbOKOnly, "á¨é§àµ×͹"
    Exit Sub
    End If
Else
    Exit Sub

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

[snasui]

แนบไฟล์หลังปรับ Code มาด้วยทุกครั้ง เพื่อนสมาชิกจะได้ช่วยดูให้ได้ครับ

[chanakan Cherdchoo]

Code: Select all

Sub SaveM1_Click()
Dim x As Range
Dim answer As VbMsgBoxResult
answer = MsgBox("¤Ø³µéͧ¡Òúѹ·Ö¡¢éÍÁÙÅãªèËÃ×ÍäÁè", vbYesNo, "ºÑ¹·Ö¡¢éÍÁÙÅ")
If answer = vbYes Then
    On Error Resume Next
    Set x = Range("f9:ab18", "c7").SpecialCells(xlCellTypeBlanks)
       On Error GoTo 0
    If Not x Is Nothing Then
        MsgBox "â»Ã´ÃкآéÍÁÙÅãËé¤Ãº¶éǹ", vbCritical + vbOKOnly, "á¨é§àµ×͹"
    Exit Sub
    End If
Else
    Exit Sub

แนบไฟล์ที่ปรับโค้ดมาเรียบร้อยแล้วค่ะอาจารย์

[snasui]

ปรับ Set x = Range("f9:ab18", "c7").SpecialCells(xlCellTypeBlanks) เป็น Set x = Range("f9:ab18, c7").SpecialCells(xlCellTypeBlanks) ครับ

ส่วนหนึ่งของ Code ที่ให้ไปตามด้านล่าง

Code: Select all

j = 1 'Paste on row 9
    c = 0
    For Each r In .Range("J9, L9")
        For Each rng In r.Resize(10)
            lstRng.Offset(j, c).Value = rng.Value
            j = j + 2
        Next rng
        j = 1
        c = c + 1
    Next r

ตรง For Each r In .Range("J9, L9") หมายถึงหากข้อมูลใดเริ่มบรรทัดที่ 9 เหมือนกัน ให้มาเติมเข้าไปที่ .Range("J9, L9") เช่น .Range("J9, L9, F9, G9, Z9, AA9 ,XFD9") เป็นต้น สังเกตว่าเป็นการเขียน Code เพียงชุดเดียวแต่ทำงานได้ครอบคลุมทุกข้อมูลที่เริ่มด้วยบรรทัดที่ 9 และไม่ลืมปรับใช้กับกรณีเริ่มบรรทัดที่ 8 ด้วยครับ