ขอรบกวนช่วยเรื่อง Code VBA เมื่อเทียบค่าตรงกัน

[snasui]

Error ฟ้องว่าอย่างไรครับ

[nattasiray]

ที่เกิด Error ณ บรรทัดที่ชื่อ แมโคร เป็นเพราะคุณเอา Comment ไปต่อท้ายครับ ให้ลองย้ายลงมาข้างล่างก่อนครับ

ตรวจสอบว่า มี End Sub เกินหรือไม่ หรือ ลืมเขียนคำสั่ง End If ปิดเงื่อนไขหรือไม่ หรือลืมเขียน End with หรือไม่

ก่อนจะรันแมโครใด ๆ ก่อนตาม ให้คลิกเมนู Debug แล้วคลิก Compile VBAProject ในเมนูย่อย เพื่อให้โปรแกรมไปตรวจสอบความถูกต้องของรหัส และช่วยให้ประมวลผลเร็วขึ้น

[suka]

อาจารย์ เป็นตามภาพนี้ค่ะ

[snasui]

แสดงว่ามีการเปิด With... แต่ไม่ได้ปิดด้วย End With ลองตรวจสอบดูว่าเปิด With ไว้ตรงไหนและยังไม่ปิดด้วย End With ครับ

[suka]

ขอบคุณค่ะคุณnattasiray ได้รับความรู้และวิธีตรวจสอบเพิ่มขึ้นค่ะ

ขอบคุณค่ะอาจารย์ เดี๋ยวลองตรวจสอบดูค่ะ ได้ผลอย่างไรจะกลับมาแจ้งผลค่ะ

ขอบพระคุณมากๆค่ะ

[suka]

อาจารย์คะ ปิดด้วย End With ไม่ Error ยอดไม่ตรงไม่คัดลอกได้แล้วค่ะ
แต่ยังติดตรงยอดไม่ตรงไม่ต้องใส่ Y ที่ชีท Database คอลัมน์ AC ยังไม่ได้ค่ะจะปรับ Code อย่างไรคะ ขอรบกวนอาจารย์ด้วยค่ะ

อาจารย์คะ ขอรบกวนเรื่อง Code ให้ตรวจสอบหากชีท Form เซลล์ L4+L6 บวกกันแล้วยอดไม่ตรงกับยอดในเซลล์ J8 ชีท Form จะไม่สามารถกดปุ่ม Record ได้ค่ะ

ชือ BeenArL อยู่ที่ Module1 ค่ะ

ขอบคุณค่ะ

Code: Select all

Sub BeenArL()
    Dim rSource As Range
    Dim rTarget As Range
    Dim rs As Range                         ' ปุ่มบันทึกรับชำระ ชีท Form
    Dim rt As Range
    Dim i As Integer
    With Sheets("Form")
        Set rSource = .Range("B3:B47")
    End With
    With Sheets("Database")
        Set rTarget = .Range("D2", .Range("D" & Rows.Count).End(xlUp))
    End With
    Application.Calculation = xlCalculationManual
    For Each rs In rSource
        For Each rt In rTarget
            If rt = rs Then rt.Offset(0, 25) = "Y"
        Next rt
    Next rs
    Application.Calculation = xlCalculationAutomatic
    With ActiveSheet
     i = (.Range("L4") + .Range("L6"))
    If i <> .Range("J8") Then
        MsgBox "โปรดตรวจจำนวนเงินและบันทึกใหม่"
        Exit Sub
    End If
    End With
    Application.ScreenUpdating = False
    Sheets("TemBilling").Range("A12:O12").Copy
    Sheets("AR").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    Sheets("TemBilling").Range("P12:W12").Copy
    Sheets("Report").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    Sheets("Form").Range("H1,J2,I4:L4,L6,G4").ClearContents
    With Sheets("Form")
            .Range("J6") = .Range("J6") + 1
        End With
        Application.ScreenUpdating = True
End Sub

[snasui]

Code สำหรับการตรวจสอบคือ

Code: Select all

    With ActiveSheet
     i = (.Range("L4") + .Range("L6"))
    If i <> .Range("J8") Then
        MsgBox "โปรดตรวจจำนวนเงินและบันทึกใหม่"
        Exit Sub
    End If
    End With

ต้องวางไว้ก่อน Code ที่จะให้ทำงานเมื่อผ่านการตรวจสอบคือ Code ด้านล่างครับ

Code: Select all

For Each rs In rSource
     For Each rt In rTarget
         If rt = rs Then rt.Offset(0, 25) = "Y"
     Next rt
Next rs

หากวางไว้ทีหลังย่อมไม่มีผลหรือไม่เกิดประโยชน์ เพราะเป็นการ Mark ค่า "Y" ไปเรียบร้อยแล้วไม่ว่ายอดจะตรงหรือไม่ตรง

[suka]

อาจารย์คะ รบกวนช่วยด้วยค่ะ วาง Code แบบด้านล่างนี้ก็ไม่ได้ค่ะ

Code: Select all

Sub BeenArL()
    Dim rSource As Range
    Dim rTarget As Range
    Dim rs As Range                                            ' ปุ่มบันทึกรับชำระ ชีท Form
    Dim rt As Range
    Dim i As Integer
    With Sheets("Form")
        Set rSource = .Range("B3:B47")
    End With
    With Sheets("Database")
        Set rTarget = .Range("D2", .Range("D" & Rows.Count).End(xlUp))
    End With
    With ActiveSheet
     i = (.Range("L4") + .Range("L6"))
    If i <> .Range("J8") Then
        MsgBox "โปรดตรวจจำนวนเงินและบันทึกใหม่"
        Exit Sub
    End If
    End With
    Application.Calculation = xlCalculationManual
    For Each rs In rSource
        For Each rt In rTarget
            If rt = rs Then rt.Offset(0, 25) = "Y"
        Next rt
    Next rs
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = False
    Sheets("TemBilling").Range("A12:O12").Copy
    Sheets("AR").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    Sheets("TemBilling").Range("P12:W12").Copy
    Sheets("Report").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    Sheets("Form").Range("H1,J2,I4:L4,L6,G4").ClearContents
    With Sheets("Form")
            .Range("J6") = .Range("J6") + 1
        End With
        Application.ScreenUpdating = True
End Sub

ลองสับตำแหน่งการวางแบบด้านล่างนี้ก็ไม่ได้ทำไม่สำเร็จค่ะ

Code: Select all

Sub BeenArL()
    Dim rSource As Range
    Dim rTarget As Range
    Dim rs As Range                                            ' ปุ่มบันทึกรับชำระ ชีท Form
    Dim rt As Range
    Dim i As Integer
    With Sheets("Form")
        Set rSource = .Range("B3:B47")
    End With
    With Sheets("Database")
        Set rTarget = .Range("D2", .Range("D" & Rows.Count).End(xlUp))
    End With
    Application.Calculation = xlCalculationManual
    With ActiveSheet
     i = (.Range("L4") + .Range("L6"))
    If i <> .Range("J8") Then
        MsgBox "โปรดตรวจจำนวนเงินและบันทึกใหม่"
        Exit Sub
    End If
    End With
    For Each rs In rSource
        For Each rt In rTarget
            If rt = rs Then rt.Offset(0, 25) = "Y"
        Next rt
    Next rs
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = False
    Sheets("TemBilling").Range("A12:O12").Copy
    Sheets("AR").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    Sheets("TemBilling").Range("P12:W12").Copy
    Sheets("Report").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    Sheets("Form").Range("H1,J2,I4:L4,L6,G4").ClearContents
    With Sheets("Form")
            .Range("J6") = .Range("J6") + 1
        End With
        Application.ScreenUpdating = True
End Sub

[snasui]

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

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

[suka]

อาจารย์คะ ไม่ได้เพราะยอดตรงหรือไม่ตรงจะแจ้งเตือนอย่างเดียวค่ะ

ต้องการให้ทำงานตามนี้ค่ะ

ที่ชีท Form ถ้ายอดที่เซลล์ L4 บวก L6 รวมกันแล้วยอดได้เท่ากับเซลล์ J8 เมื่อกดปุ่ม Record ให้คัดลอกไปไว้ชีท Report และชีท AR พร้อมกับวาง Y ที่ชีท Database คอลัมน์ AC

ถ้าที่ชีท Form ยอดที่เซลล์ L4 บวก L6 รวมกันแล้วยอดไม่ตรงให้แสดงข้อความแจ้งเตือนและไม่มีการคัดลอกใดๆและไม่วาง Y ที่ชีท Database คอลัมน์ AC ค่ะ

ตัวอย่างไฟล์แนบที่ชีท Form ยอดที่เซลล์ L4 บวก L6 รวมกันแล้วยอดได้เท่ากับเซลล์ J8 แล้วกดปุ่ม Record ก็แค่แจ้งเตือนอย่างเดียวค่ะ

ขอบคุณค่ะ

[snasui]

เนื่องจากตัวเลขที่ใช้มีจุดทศนิยม ลองเปลี่ยนการประกาศตัวแปร i เป็น Double ครับ จะได้เป็น Dim i As Double

[suka]

อ๋อ เป็นอย่างนี้นี่เอง ใช้ได้แล้วค่ะอาจารย์

ขอบพระคุณมากๆค่ะ

[suka]

อาจารย์คะ ขอรบกวนอีกรอบค่ะ

การประกาศตัวแปร i เป็น Dim i As Double สามารถใช้กับเลข 7 หลักมีจุดทศนิยมด้วยได้ไหมคะ
ได้ใส่ยอดไป 7 หลักและมีจุดทศนิยม โปรแกรมแจ้งเตือนอย่างเดียวค่ะ

ขอบคุณค่ะ

[snasui]

ลองประกาศตัวแปรเป็น Decimal ดูครับ หากยังไม่ได้แนบไฟล์พร้อมตัวอย่างข้อมูลที่ติดปัญหามาอีกรอบครับ

สำหรับ Data Type และค่าสูงสุดต่ำสุด ขนาด Memory ที่ใช้ ดูที่นี่ครับ http://msdn.microsoft.com/en-us/library ... s.60).aspx

[suka]

ประกาศตัวแปรเป็น Decimal แล้วไม่ได้ค่ะ

ไฟล์แนบที่ชีท Form ใช้เลข 6 หลักก็ไม่ได้แจ้งเตือนอย่างเดียวค่ะ

ชื่อ BeenArL อยู่ที่ Module1 ค่ะ

ขอบคุณค่ะ

[snasui]

อันที่จริงแค่ประกาศเป็น Single ก็สามารถรองรับทศนิยมได้ถึง 7 หลัก ยิ่งประกาศเป็น Double ก็จะได้มากกว่าอีกมาก

ผมมาตรวจสอบดูใหม่การประกาศเป็น Decimal ต้องประกาศเป็น Variant แทน คือประกาศเป็น Dim i As Variant เนื่องจาก Decimal อยู่ภายใต้ Variant อีกที ไม่สามารถประกาศเป็น Decimal ตรง ๆ ได้ แต่สำหรับงานนี้ผมคิดว่าประกาศเป็น Double ก็พอแล้ว

ตามไฟล์แที่แนบมาผมทดสอบประกาศเป็น Double แล้วไม่พบกว่ามีปัญหาใด สามารถ Run ได้ตามปกติ ลองแนบตัวอย่างข้อมูลที่ Run แล้วติดปัญหามาครับ

[suka]

จากไฟล์ที่ใช้งานจริงเมื่อใส่ยอดที่เซลล์ L4 และ L6 ตรงกับเซลล์ J8 ใส่สูตรที่เซลล์ L8 =SUM(J8)-L4-L6
พบตัวเลขที่เซลล์ L8 -0.00 ค่ะ

แต่พอคัดลอกมาที่ไฟล์ต้วอย่างกลับใช้งานได้ไม่พบยอดติดลบที่เซลล์ L8 0.00 ค่ะ

[snasui]

ลองใส่ฟังก์ชั่น Round เข้าไปครอบสูตรเดิมเพื่อตัดให้เป็นทศนิยม 2 ตำแหน่งจริง ๆ ดูครับ เช่น

=Round(Yourformula,2)

เป็นการปัดค่าที่ได้จากสูตรเดิมให้เป็นทศนิยม 2 ตำแหน่ง Code ที่ใช้ก็จะนำตัวเลขหลังจากปัดทศนิยมแล้วไปเทียบกัน จะได้ไม่มีปัญหาเรื่องทศนิยมทีได้จากการคีย์กับทศนิยมที่ได้จากสูตรไม่เท่ากัน

[suka]

ขอบพระคุณมากค่ะอาจารย์ ทำงานได้แล้วค่ะ

[suka]

ขอรบกวนเรื่องปรับสูตรเพิ่มค่ะ

ไฟล์แนบที่ชีท Form จากเดิมเลือกวันที่เริ่มต้นเซลล์ B1 และวันที่สิ้นสุดเซลล์ D1

ให้สูตรเรียกเพิ่มเป็น

เลือกวันที่เริ่มต้นเซลล์ B1 และวันที่สิ้นสุดเซลล์ D1 และเลือกกลุ่มเอกสารที่เซลล์ E1 ค่ะ

ขอบคุณค่ะ