Re: ขอช่วยเรื่องการจัดระบบฐานข้อมูลที่ถูกต้องค่ะ
Posted: Fri Jul 26, 2013 9:37 pm
ผมได้ปรับ Code มาเป็นตัวอย่างโดยปรับ Code ที่ไม่พบว่ามีการใช้งานเป็น Comment ลองดูตามด้านล่างครับ
Code: Select all
Sub BeenArL() ' ปุ่มบันทึกรับชำระ ชีท Formรับชำระ
Dim wbShare As Workbook
Dim formBook As Workbook
Dim rSource As Range
Dim rTarget As Range
Dim rs As Range
Dim rt As Range
Dim i As Double
Set formBook = ThisWorkbook
Set wbShare = Workbooks("ArBookShare.xlsx.xlsx")
With formBook.Sheets("Form")
Set rSource = .Range("B3:B50")
End With
With formBook.Sheets("Database")
Set rTarget = .Range("E2", .Range("E" & Rows.Count).End(xlUp))
End With
With formBook.Sheets("Form")
i = (.Range("L9") + .Range("M9") + .Range("M12"))
If i <> .Range("J12") 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
' With Workbooks
Set rt = wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
' End With
' With formBook.Worksheets("TemBilling")
' Set rSource = .Range("A2:P2").Resize(.Range("Q1"))
' End With
formBook.Sheets("TemBilling").Range("A2:P2").Resize(.Range("q1")).Copy
wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp) _
.Offset(1, 0).PasteSpecial xlPasteValues
' With Worksheets("TemBilling")
' Set rSource = .Range("P10:W10").Resize(.Range("Y9"))
' End With
formBook.Sheets("TemBilling").Range("P10:W14").Copy
formBook.Sheets("Report").Range("A" & Rows.Count).End(xlUp) _
.Offset(1, 0).PasteSpecial xlPasteValues
formBook.Sheets("Form").Range("G4:G8,H1,J2,I4:N8,I6").ClearContents
With formBook.Sheets("Form")
.Range("J10") = .Range("J10") + 1
End With
Application.ScreenUpdating = True
End Sub