VB ขึ้น Error ที่ Loop คะ

[nongnok]

รบกวน Check Loop คะ ที่ ปุ่ม Control ที่ Sheet "Cal"

ตามไฟล์แนบคะ

[nongnok]

ขออธิบายคะ เมื่อครู่กำลังจะออกจากออฟฟิต จึงไม่ได้อธิบายคะ

สิ่งที่ต้องการให้โปรแกรมทำคือ Copy 2 Columns ไปไว้ Sheet ละ Column คะ โดยให้เรียงกันไปให้ได้ 1210 Columns คะ

ซึ่งตอนนี้ Copy ไปวางได้แล้วคะ แต่พอใส่การวน Loop เข้าไปก็มีปัญหาคะ ในปุ่มคำสั่งที่สร้างขึ้นมา 2 ปุ่ม ปัญหาต่างกันคะ

ปุ่ม Copy&Paste มีปัญหาที่ Loop ไม่ถึง 1210 รอบคะ ขึ้น Error ในขั้นตอนสั่งหยุดคะ
ปุ่ม Rand 2 มีปัญหา End sub ขึ้น Error คะ

รบกวนด้วยคะ พึ่งเริ่มหัดเขียน ทำโดยการดูของท่านอื่นๆ มาปรับแก้คะ หากมี Code ไหนที่ไม่จำเป็นต้องมี รบกวนใส่ " ' " ไว้ด้านหน้าได้เลยคะ

ขอบคุณคะ

[snasui]

ลองอธิบายขั้นตอนมาใหม่ครับว่าต้องการจะทำอะไร มีขั้นตอนการทำงานอย่างไร

สำหรับ Code ที่แนบมาได้ลอง Run ทีละ Step โดยกดแป้น F8 ดูครับ แล้วแจ้งมาว่าติดที่บรรทัดไหน

[nongnok]

ขอบคุณสำหรับคำแนะนำคะ

สิ่งที่ต้องการให้โปรแกรมทำคือ เก็บค่าในช่อง cost และ profit&lost ไปรวมกันใน Column คะ เพราะต้องนำมาวิเคราะห์ต่อไปคะ โดยข้อมูลของ Cost และ Profit&Lost จะต้องมีอย่างละ 1210 ข้อมูลคะ

โปรแกรมทำงานดังนี้คะ
1. ลบข้อมูลใน Sheet1 เนื่องจากข้อมูลที่ Copy มานั้น มาจากเลขสุ่มคะ ถ้าไม่ Copy มาในครั้งเดียวกัน ค่าของ Cost และ Profit&Lost ที่ได้จะไม่ได้มาจากเลขสุ่มตัวเดียวกันคะ ดังนั้นจึงใช้ Sheet1 เป็นที่ Paste ไว้ชั่วคราวคะ
2. Copy & Paste ข้อมูลในช่อง Cost และ Profit&Lost จาก Sheet1 ไปไว้แยก Sheet กันคะ ซึ่งในที่นี้คือ Sheet2 และ Sheet 3 คะ
3. เนื่องจากต้องการข้อมูลของ Cost และ Profit&Lost อย่างละ 1210 ข้อมูล จึงทำ Loop ให้โปรแกรม Run ให้คะ

เท่านี้คะที่ทำในปุ่ม Control ทั้ง 2 อันคะ เพราะได้ใส่สูตรใน Excel ไว้แล้ว จึงไม่ได้เขียนอะไรเพิ่มคะ (ได้แนบไฟล์ใหม่ที่ทำตามด้านล่างมาด้วยคะ)


และได้ทำการกด F8 ในปุ่ม Copy&Paste แล้วได้ใส่เครื่องหมาย " ' " บรรทัดที่คิดว่าไม่ได้ใช้งานด้วยคะ

และเมื่อ Run ถึง คำสั่งหยุดคือ If Sheets("Sheet3").Rows>1211 Then Total=Total+1 มี Error ขึ้นว่า Run-time error '7': Out of memory คะ หมายความว่า Run เยอะเกินไปหรือคะ

ปุ่มที่ 2 ชื่อ Rand 2 เมื่อ Run ไปมี Error ขึ้นว่า For without Next คะ ได้ใส่ Next j ไปแล้วคะ และได้ใส่เครื่องหมาย " ' " เช่นกันกับปุ่มแรกคะ

เมื่อ Run ไปถึง ที่เดียวกันกับปุ่มแรกคือ If Sheets("Sheet3").Rows>1211 Then มี Error ขึ้นว่า Run-time error '438': Object doesn't support this property or method คะ

เมื่อถึงบรรทัดที่มี code ว่า MsgBox Total & " values higher than 1210 " มี MsgBox ขึ้นว่า 0values higher than 1210 คะ

code "Next j" ที่ใส่ไปมีปัญหาทำให้ค้างไปไม่ถึง Exd sub คะ

[snasui]

สิ่งที่ต้องการให้โปรแกรมทำคือ เก็บค่าในช่อง cost และ profit&lost ไปรวมกันใน Column คะ เพราะต้องนำมาวิเคราะห์ต่อไปคะ โดยข้อมูลของ Cost และ Profit&Lost จะต้องมีอย่างละ 1210 ข้อมูลคะ

โปรแกรมทำงานดังนี้คะ
1. ลบข้อมูลใน Sheet1 เนื่องจากข้อมูลที่ Copy มานั้น มาจากเลขสุ่มคะ ถ้าไม่ Copy มาในครั้งเดียวกัน ค่าของ Cost และ Profit&Lost ที่ได้จะไม่ได้มาจากเลขสุ่มตัวเดียวกันคะ ดังนั้นจึงใช้ Sheet1 เป็นที่ Paste ไว้ชั่วคราวคะ
2. Copy & Paste ข้อมูลในช่อง Cost และ Profit&Lost จาก Sheet1 ไปไว้แยก Sheet กันคะ ซึ่งในที่นี้คือ Sheet2 และ Sheet 3 คะ
3. เนื่องจากต้องการข้อมูลของ Cost และ Profit&Lost อย่างละ 1210 ข้อมูล จึงทำ Loop ให้โปรแกรม Run ให้คะ

ลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Sub Test0()
    Dim i As Integer
    Application.Calculation = xlManual
    For i = 1 To 1210
        Sheets("Cal").Range("H1:H111").copy
        Sheets("Sheet2").Range("A1").End(xlToRight).Offset(0, 1) _
            .PasteSpecial xlPasteValues
        Sheets("Cal").Range("I1:I111").copy
        Sheets("Sheet3").Range("A1").End(xlToRight).Offset(0, 1) _
            .PasteSpecial xlPasteValues
    Sheets("Cal").Calculate
    Next i
    Application.Calculation = xlAutomatic
End Sub

[nongnok]

Run ได้แล้วคะ ขอบคุณมากคะ ^^

[nongnok]

อาจารย์คะ รบกวนอีกครั้งคะ

ได้เพิ่มสิ่งที่เก็บไว้ใน Sheet อื่นอีก 2 Sheets คะ แต่ขั้น Error ที่ Sheets 2, 3 & 4 คะ Error ขึ้นเหมือนกันว่า Run-time error '1004': Application or object-defined error คะ

Code: Select all

Private Sub CommandButton3_Click()
  
    Dim i As Integer
    Application.Calculation = xlManual
    For i = 1 To 2
        Sheets("Cal").Range("a2").copy
        Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0) _
            .PasteSpecial xlPasteValues
        Sheets("Cal").Range("D1:D111").copy
        'Sheets("Sheet2").Range("A1").End(xlToRight).Offset(0, 1) _
            .PasteSpecial xlPasteValues
        Sheets("Cal").Range("H1:H111").copy
        'Sheets("Sheet3").Range("A1").End(xlToRight).Offset(0, 1) _
            .PasteSpecial xlPasteValues
        Sheets("Cal").Range("I1:I111").copy
        Sheets("Sheet4").Range("A1").End(xlToRight).Offset(0, 1) _
            .PasteSpecial xlPasteValues
    Sheets("Cal").Calculate
    Next i
    Application.Calculation = xlAutomatic

End Sub

[snasui]

ในการสอบถามปัญหาแล้ว สำหรับ Code ที่ใช้งานและมีปัญหาไม่ควร Mark เป็น Comment ไว้ด้านหน้าครับ หากต้องการแจ้งว่า Code ใดมีปัญหาให้ Mark Comment ไว้ด้านบน หรือ ด้านท้าย

สำหรับที่ถามมาลองปรับ Code เป็นตามด้านล่าง

Code: Select all

Sub Test0()
    Dim i As Integer
    Application.Calculation = xlManual
    For i = 1 To 2
        Sheets("Cal").Range("a2").copy
        Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0) _
            .PasteSpecial xlPasteValues
        Sheets("Cal").Range("D1:D111").copy
        Sheets("Sheet2").Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1) _
            .PasteSpecial xlPasteValues
        Sheets("Cal").Range("H1:H111").copy
        Sheets("Sheet3").Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1) _
            .PasteSpecial xlPasteValues
        Sheets("Cal").Range("I1:I111").copy
        Sheets("Sheet4").Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1) _
            .PasteSpecial xlPasteValues
        Sheets("Cal").Calculate
    Next i
    Application.Calculation = xlAutomatic
End Sub

[nongnok]

ขอบคุณอาจารย์มากคะ Run และ เก็บข้อมูลได้แล้วคะ

ต้องขอโทษเรื่องเครื่องหมาย " ' " คะ เนื่องจากตอนกด F8 เพื่อตรวจสอบได้ใส่เครื่องหมายให้ผ่านตรงที่ Error ไปตรวจเช็คลำดับต่อไปคะ และตอน Copy มาไม่ได้เอาออกคะ ^^ ครั้งต่อไปจะทำตามที่อาจารย์ได้แนะนำคะ