Page 1 of 1

VBA ใส่ค่าไม่ตรงกัน Code วางข้อมูลผิดพลาดค่ะ

Posted: Fri Dec 09, 2016 6:30 pm
by suka
เรียนอาจารย์ค่ะ รบกวนช่วยปรับโค้ดค่ะ

โค้ดจากตัวอย่างไฟล์แนบมีปัญหาคือ
ที่ไฟล์ Book ชีท Form หากค่าที่เซลล์ P9 ตรงกับค่าในเซลล์ J12 Code สามารถใช้ได้ปกติดีนำข้อมูลจากไฟล์PoWbShare มาวางที่ชีท Database ไฟล์ Book ได้ค่ะ

แต่หาาค่าเซลล์ P9 และเซลล์ J12 ไม่ตรงกัน Code วางข้อมูลผิดไฟล์ คือนำข้อมูลจากไฟล์ ArBill_Share.xlsx มาวางที่ชีท Database แทนค่ะ

ความต้องการ
ชีท Form ไฟล์ Book เซลล์ B3:B10 เลขเอกสารตรงกับเลขในเซลล์ F ไฟล์ PoWbShare ให้วางอักษร B ไว้ที่คอลัมน์ AF แล้ว Copy ข้อมูลจากไฟล์ PoWbShare มาวางที่ไฟล์ Form ชีท Database ค่ะ
และเอาข้อมูลเซลล์ F20:I20 และ A2:N2 ชีท Tem ไปวางไว้ที่ไฟล์ ArBill_Share ค่ะ

ตัวอย่างที่ต้องการตามไฟล์แนบ PoWbShare ArBill_Share.xlsx และชีท Database ค่ะ
Code ในไฟล์ตัวอย่างไม่ทราบควรปรับอย่างไรค่ะ

Re: VBA ใส่ค่าไม่ตรงกัน Code วางข้อมูลผิดพลาดค่ะ

Posted: Fri Dec 09, 2016 6:35 pm
by snasui
:D Code ที่ทำงานทั้งหมดที่ถามมานั้นเขียนไว้อย่างไร นำมาเขียนไว้อีกครั้งในฟอรัมครับ

Re: VBA ใส่ค่าไม่ตรงกัน Code วางข้อมูลผิดพลาดค่ะ

Posted: Fri Dec 09, 2016 6:49 pm
by suka
ค่ะอาจารย์ Code ที่ใช้ในไฟล์นี้ทั้งหมดค่ะ

Code: Select all

Sub MainCode()
        Dim wdShareOpen As Boolean
        Dim ArShareOpen As Boolean
        Dim wdShare As Workbook
        Dim ArShare As Workbook
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
        Set wdShare = Workbooks.Open("E:\My P S  Project.xls\PS.BookShare.2\AR.ระบบลูกหนี้.2\VBA\PoWbShare.xlsx", False, False)
        Set ArShare = Workbooks.Open("E:\My P S  Project.xls\PS.BookShare.2\AR.ระบบลูกหนี้.2\VBA\ArBill_Share.xlsx", False, False)
        Call SubCode_BillingDetails     'นำข้อมูลไปวางที่ไฟล์ ArBillBookShare.xlsx ชีท Sheet1 คอลัมน์ A2:D
        Call ArBilling
        Call Database_Copy
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
End Sub
ที่นำข้อมูลไปไว้ที่ไฟล์ ArBillBookShare.xlsx ใช้สอง Code ค่ะ

Code: Select all

Sub SubCode_BillingDetails()
        'นำข้อมูลไปวางที่ไฟล์ ArBillBookShare.xlsx ชีท Sheet1 คอลัมน์ A2:D
         Dim formBook As Workbook
         Dim dtShare As Workbook
         Dim mr As Range
         Dim i As Double
         Set formBook = ThisWorkbook
         Set dtShare = Workbooks("ArBill_Share.xlsx")
         Set mr = dtShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        With formBook.Sheets("Form")
            i = (.Range("P9") + .Range("M12"))
            If i <> .Range("J12") Then
                Exit Sub
            End If
        End With
        With formBook.Sheets("Tem")
               .Range("F20:I20").Resize(.Range("J19")).Copy
               dtShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp) _
               .Offset(1, 0).PasteSpecial xlPasteValues
        End With
  End Sub
และ

Code: Select all

Sub ArBilling()
        'Dim wdShareOpen As Boolean
        Dim wdShare As Workbook
        Dim formBook As Workbook
        Dim wbShare As Workbook
        Dim wb As Workbook ' declare wb as workbook
        Dim rSource As Range
        Dim rTarget As Range
        Dim rs As Range
        Dim rt As Range
        Dim i As Double
        Dim lastRow As Long
        Dim shRange As Range
        Set formBook = ThisWorkbook
        Set wbShare = Workbooks("ArBill_Share")
        For Each wb In Workbooks ' loop wb not loop wdShare
            If wb.Name = "PoWbShare.xlsx" Then
                wdShareOpen = True
            End If
        Next wb
        If Not wdShareOpen Then
        End If
        Set wdShare = Workbooks("PoWbShare.xlsx") 'set wdShare after open not before open
        With formBook.Sheets("Form")
            Set rSource = .Range("B3:B10")
        End With
        With wdShare.Sheets("Sheet1")
            Set rTarget = .Range("F2", .Range("F" & Rows.Count).End(xlUp))
        End With
        With formBook.Sheets("Form")
            i = (.Range("P9") + .Range("M12"))
            If i <> .Range("J12") 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, 26) = "B"
            Next rt
        Next rs
        With formBook.Sheets("Tem")
        .Range("A2:N2").Resize(.Range("Q1")).Copy
            wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp) _
                .Offset(0, 4).PasteSpecial xlPasteValues
       End With
        'formBook.Sheets("Form").Range("H1,J4:O8,M12").ClearContents
        With formBook.Sheets("Form")
            .Range("j2") = .Range("j2") + 1
            .Range("i4") = .Range("i4") + 1
        End With
        wbShare.Save
        wbShare.Close
End Sub
Code นี้ใช้เพื่อ Copy ข้อมูลมาไว้ชีท Database ไฟล์ Book ค่ะ

Code: Select all

Sub Database_Copy()
        Dim wbShare As Workbook
        Dim formBook As Workbook
        Set formBook = ThisWorkbook
        Set wbShare = Workbooks("PoWbShare.xlsx")
        ActiveSheet.UsedRange.Copy
        formBook.Activate
        Sheets("Database").Select
        Range("A1").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        wbShare.Save
        wbShare.Close
        Sheets("Form").Select
End Sub

Re: VBA ใส่ค่าไม่ตรงกัน Code วางข้อมูลผิดพลาดค่ะ

Posted: Fri Dec 09, 2016 7:00 pm
by snasui
:D ค่อย ๆ ถามตอบกันไปนะครับ

ที่ MainCode บรรทัดด้านล่างนี้เอาไว้ทำอะไรครับ

Code: Select all

Set wdShare = Workbooks.Open("E:\My P S  Project.xls\PS.BookShare.2\AR.ระบบลูกหนี้.2\VBA\PoWbShare.xlsx", False, False)
Set ArShare = Workbooks.Open("E:\My P S  Project.xls\PS.BookShare.2\AR.ระบบลูกหนี้.2\VBA\ArBill_Share.xlsx", False, False)
เมื่อกำหนดตัวแปรแล้วจะต้องมีการนำไปใช้ ไม่ทราบว่าได้นำไปใช้ตรงไหน อย่างไร หากไม่ได้นำไปใช้ ไม่จำเป็นต้องกำหนดตัวแปรครับ

Re: VBA ใส่ค่าไม่ตรงกัน Code วางข้อมูลผิดพลาดค่ะ

Posted: Fri Dec 09, 2016 7:09 pm
by suka
นำมาใช้เพือเปิดไฟล์ PoWbShare.xlsx และ ArBill_Share.xlsx ทั้งสองเมือวางข้อมูลแล้วค่อยปิดไฟล์ทั้งสองค่ะ

Re: VBA ใส่ค่าไม่ตรงกัน Code วางข้อมูลผิดพลาดค่ะ

Posted: Fri Dec 09, 2016 7:31 pm
by snasui
:D นำไฟล์มาเปิด ไม่จำเป็นต้องใส่ตัวแปร ยกเว้นนำตัวแปรนั้นไปใช้ต่อ Procedure MainCode ไม่ได้นำตัวแปรนั้นไม่ใช้ต่อแต่อย่างใด Code ควรจะเหลือเป็นด้านล่าง ลองปรับใช้ดูว่าทำงานได้หรือติดปัญหาตรงไหน อย่างไรครับ

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

Code: Select all

Workbooks.Open "E:\My P S  Project.xls\PS.BookShare.2\AR.ระบบลูกหนี้.2\VBA\PoWbShare.xlsx", False, False
Workbooks.Open "E:\My P S  Project.xls\PS.BookShare.2\AR.ระบบลูกหนี้.2\VBA\ArBill_Share.xlsx", False, False

Re: VBA ใส่ค่าไม่ตรงกัน Code วางข้อมูลผิดพลาดค่ะ

Posted: Fri Dec 09, 2016 8:08 pm
by suka
อาจารย์คะ ปรับใช้แล้วยังเหมือนเดิมค่ะ

ลองใส่ตัวเลขไม่ตรงกัน Copy ข้อมูลมาผิดไฟล์ค่ะ รูปที่ 1

ถ้าใส่ค่าที่เซลล์ P9 ตรงกับค่าในเซลล์ J12 Code สามารถใช้ได้เป็นปกติ ที่ต้องการให้ข้อมูลมาตามรูปที่ 2 รูปล่างค่ะ

Re: VBA ใส่ค่าไม่ตรงกัน Code วางข้อมูลผิดพลาดค่ะ

Posted: Fri Dec 09, 2016 8:10 pm
by snasui
:D ที่ให้ปรับไปนั้น ไม่ได้เกี่ยวกับการแก้ปัญหา แค่ให้ปรับ Code เพื่อใช้ให้ตรงกับวัตถุประสงค์เท่านั้น กรุณาอ่านและทำความเข้าใจ เกรงว่าจะหลงประเด็นครับ

ในส่วนที่จับภาพมานั้นอยู่ใน Code ชื่อว่าอะไรครับ

Re: VBA ใส่ค่าไม่ตรงกัน Code วางข้อมูลผิดพลาดค่ะ

Posted: Fri Dec 09, 2016 9:10 pm
by suka
Code นี้ค่ะอาจารย์ ถ้าใส่ค่าไม่ถูกต้องไม่ต้อง Copy ข้อมูลมา

ได้ปรับใช้ End แทนการใช้ Exit Sub Code สามารถใช้งานได้ดีแล้วค่ะ

ขอบคุณอาจารย์มากมายค่ะที่ค่อยช่วยเหลือทุกปัญหาแก้ได้หมดค่ะ

Code: Select all

With formBook.Sheets("Form")
            i = (.Range("P9") + .Range("M12"))
            If i <> .Range("J12") Then
                MsgBox "โปรดตรวจจำนวนเงินและบันทึกใหม่"
                'Exit Sub
                End
            End If
        End With