ขอช่วยเรื่องการจัดระบบฐานข้อมูลที่ถูกต้องค่ะ

[suka]

เรียนอาจารย์และท่านผู้รู้ค่ะ

ขอรบกวนช่วยเหลือเรื่องการจัดระบบฐานข้อมูลที่ถูกต้องค่ะ
โดยเริ่มจากการนำข้อมูลจาก Excel ไปไว้ที่ Access ค่ะ
ได้คัดลอกจากตัวอย่างไฟล์แนบ Excel ชีท DB ตามรูปแรกบนไปที่ Access ได้ครบทุกคอลัมน์ค่ะ
แต่คัดลอกจากตัวอย่างไฟล์แนบ Excel ชีท AR ตามรูปสองล่างไปที่ Access ได้ไม่ครบได้มาตามภาพค่ะ

ขอช่วยแนะวิธีนำข้อมูลเข้า Access ที่ถูกควรทำอย่างไรคะ

ขอบคุณค่ะ

[snasui]

กรณีที่เป็น Access ให้ถามที่หมวด Other ครับ

[suka]

ค่ะอาจารย์

[suka]

เรียนอาจารย์และท่านผู้รู้ช่วยเรื่องปรับ Code ค่ะ
ต้องการปรับ Code เดิมจากไฟล์ Inventory.Share ชีท Enterthedata เมื่อกดปุ่ม Record คัดลอกนำข้อมูลไปไว้ที่ชีท Database ไฟล์ Inventory.Share Code เดิมตามด้านล่างนี้

Code: Select all

Sub PasteData()
Dim i As Integer
Dim rs As Range
Dim rt As Range
    Application.ScreenUpdating = False
    i = Worksheets("Enterthedata").Range("C225")
    With Worksheets("Template")
        Set rs = .Range(.Range("A2"), .Range("AC" & i + 1))
    End With
    Set rt = Worksheets("Database").Range("A65536").End(xlUp).Offset(1, 0)
    If Worksheets("Enterthedata").Range("C225") = True Then
        MsgBox "Please check your data. This transaction already recorded."
        Exit Sub
    End If
    If Worksheets("Enterthedata").Range("B204") = "" Then
        MsgBox "Your data is empty. Fill your data and click record button again."
        Exit Sub
    End If
    rs.Copy: rt.PasteSpecial xlPasteValues

    Application.CutCopyMode = False
    Sheets("Enterthedata").Range("D2,B204:B220,D204:D220,L204:L220,D222, E204:F220").ClearContents
    With Worksheets("Enterthedata")
    If Len(.Range("M2")) = 6 Then
        .Range("M2") = Left(.Range("M2"), 2) & Right(.Range("M2"), 4) + 1
    ElseIf Len(.Range("M2")) = 7 Then
        .Range("M2") = Left(.Range("M2"), 1) & Right(.Range("M2"), 6) + 1
    ElseIf Len(.Range("M2")) = 8 Then
        .Range("M2") = Left(.Range("M2"), 1) & Right(.Range("M2"), 7) + 1
    Else
    .Range("M2") = .Range("M2") + 1
    End If
    End With
    Application.ScreenUpdating = True
End Sub

ต้องการปรับ Code ให้คัดลอกข้อมูลไปไว้ที่ชีท Sheet1 ไฟล์ BookShare.xlsx แทนค่ะ
ได้ลองปรับ Code ตามด้านล่างนี้ ยังไม่ได้ค่ะ

Code: Select all

Sub PasteData()
Dim wbShare As Workbook
Dim formBook As Workbook
Dim i As Integer
Dim rs As Range
Dim rt As Range
Set formBook = ThisWorkbook
Set wbShare = Workbooks("BookShare.xlsx")
    Application.ScreenUpdating = False
    i = Worksheets("Enterthedata").Range("C225")
    With Worksheets("Template")
        Set rs = .Range(.Range("A2"), .Range("AB" & i + 1))
    End With
   wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    If Worksheets("Enterthedata").Range("C225") = True Then
        MsgBox "Please check your data. This transaction already recorded."
        Exit Sub
    End If
    If Worksheets("Enterthedata").Range("B204") = "" Then
        MsgBox "Your data is empty. Fill your data and click record button again."
        Exit Sub
    End If
    rs.Copy: rt.PasteSpecial xlPasteValues

    Application.CutCopyMode = False
    Sheets("Enterthedata").Range("D2,B204:B220,D204:D220,L204:L220,D222, E204:F220").ClearContents
    With Worksheets("Enterthedata")
    If Len(.Range("M2")) = 6 Then
        .Range("M2") = Left(.Range("M2"), 2) & Right(.Range("M2"), 4) + 1
    ElseIf Len(.Range("M2")) = 7 Then
        .Range("M2") = Left(.Range("M2"), 1) & Right(.Range("M2"), 6) + 1
    Else
    End If
    End With
    Application.ScreenUpdating = True
End Sub

error ตามภาพนี้ค่ะ ขอบคุณค่ะ

[snasui]

ที่ Error เพราะไม่ได้ Assigned ค่าให้กับบรรทัดนั้นครับ

ค่าตัวแปรต่าง ๆ จะต้องบอกให้โปรแกรททราบด้วยว่าอ้างอิงจาก Workbook ไหน ยกตัวอย่างเช่น

Code: Select all

i = Worksheets("Enterthedata").Range("C225")

Code ด้านบนโปรแกรมจะรับรู้ได้อย่างไรว่าเรากำหนดค่า i จาก Workbook ไหนครับ ดังนั้น จะต้องบอกให้โปรแกรมทราบด้วยโดยการอ้าง Workbook เข้าไปด้านหน้าอีกทีหนึ่ง เช่น

Code: Select all

With Formbook
    i = .Worksheets("Enterthedata").Range("C225").Value
End With

หรือ

Code: Select all

i = Formbook.Worksheets("Enterthedata").Range("C225").Value

Code อื่น ๆ ก็ต้องปรับในลักษณะเดียวกันทั้งหมดครับ

[suka]

ขอบคุณค่ะอาจารย์ Code ด้านล่างนี้สามารถคัดลอกได้ตามต้องการแล้ว แต่ยังไม่แน่ใจว่า Code นี้ยังมีส่วนใดเกินหรือขาดจำเป็นต้องปรับปรุ่งหรือไม่ค่ะ

Code: Select all

Sub PasteData()
Dim wbShare As Workbook
Dim formBook As Workbook
Dim i As Integer
Dim rs As Range
Dim rt As Range
Set formBook = ThisWorkbook
Set wbShare = Workbooks("BookShare.xlsx")
    Application.ScreenUpdating = False
    With formBook
    i = Worksheets("Enterthedata").Range("C225")
    End With
    With Worksheets("Template")
        Set rs = .Range(.Range("A2"), .Range("AB" & i + 1))
    End With
    Set rt = wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    If Worksheets("Enterthedata").Range("C225") = True Then
        MsgBox "Please check your data. This transaction already recorded."
        Exit Sub
    End If
    If Worksheets("Enterthedata").Range("B204") = "" Then
        MsgBox "Your data is empty. Fill your data and click record button again."
        Exit Sub
    End If
    rs.Copy: rt.PasteSpecial xlPasteValues

    Application.CutCopyMode = False
    Sheets("Enterthedata").Range("D2,B204:B220,D204:D220,L204:L220,D222, E204:F220").ClearContents
    With Worksheets("Enterthedata")
    If Len(.Range("M2")) = 6 Then
        .Range("M2") = Left(.Range("M2"), 2) & Right(.Range("M2"), 4) + 1
    ElseIf Len(.Range("M2")) = 7 Then
        .Range("M2") = Left(.Range("M2"), 1) & Right(.Range("M2"), 6) + 1
    Else
    End If
    End With
    Application.ScreenUpdating = True
End Sub

[snasui]

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

[suka]

ขอรบกวนอีกรอบค่ะ ไฟล์ BookShare.xlsx ไม่สามารถแชร์ไฟล์ได้ค่ะ พอคลิ๊กแชร์เป็นตามภาพด้านล่างนี้ค่ะ

[snasui]

ไม่สามารถอ่านได้ ให้ตัดมาเฉพาะที่แสดงข้อความผิดพลาดเท่านั้นก็พอเพื่อจะได้เห็นภาพใหญ่ขึ้นครับ

[suka]

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

[snasui]

ทำตามที่โปรแกรมแจ้งเลยครับ ในนั้นมีบอกไว้ชัดเจนเป็นขั้นตอนอยู่แล้วว่าต้องทำอย่างไรครับ

[suka]

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

ขอรบกวนเพิ่มค่ะ หากต้องการดึงข้อมูลชีท Sheet1 ไฟล์ BookShare.xlsx มาไว้ที่ชีท Database ไฟล์ Inventory.Share
แบบสามารถเปลี่ยนแปลงตามต้นฉบับชีท Sheet1 ไฟล์ BookShare.xlsx ได้ต้องใช้สูตรอย่างไรคะ

ขอบคุณค่ะ

[snasui]

ลองเขียนมาก่อนครับ ติดตรงไหนค่อยถามกันต่อครับ

[suka]

ขอรบกวนอาจารย์และท่านผู้รู้ช่วยเรื่องปรับ Code ค่ะ
จากไฟล์แนบบ AR.Forn ต้องการปรับ Code ให้คัดลอกข้อมูลไปไว้ชีทชีท Sheet1 ไฟล์ ArBookShare.xlsx เมื่อกดปุ่ม Record ชีท Form ไฟล์ AR.Forn Code ด้านล่างล่าง Error ตามรูปค่ะ

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")
    With formBook("Form")
        Set rSource = .Range("B3:B47")
    End With
    With formBook("Database")
        Set rTarget = .Range("E2", .Range("E" & 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
    With formBook("Form")                  
        If .Range("K6") = "" 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
     Set rt = wbShare.Sheets("Sheet1").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,K6,G4").ClearContents
   With formBook("Form")
            .Range("J6") = .Range("J6") + 1
        End With
        Application.ScreenUpdating = True
End Sub

[snasui]

ที่ Error เพราะโปรแกรมไม่สามารถทำเช่นนั้นได้ครับ

การ Assign ค่าหรือกำหนดค่าให้กับ Object ไปพร้อม ๆ กับกำหนด Method หรือการกระทำ (Paste Special) ให้กับ Object ไปด้วยนั้นไม่สามารถทำได้

สิ่งที่น่าจะเป็นคือ

1. กำหนดตำแหน่งสุดท้ายที่ต้องการวางข้อมูลให้กับตัวแปรใด ๆ
2. Copy ค่าจากต้นแหล่ง
3. วางค่าไปยังตัวแปรตามข้อ 1

ยกตัวอย่าง

Code: Select all

Set rt = wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0)
Sheets("TemBilling").Range("A12:O12").Copy
rt.PasteSpecial xlPasteValues

[suka]

เรียนอาจารย์ค่ะ ขอช่วยเรื่องปรับ Code ด้านล่างนี้ค่ะ
ความต้องการเมื่อชีท Form ที่เซลล์ G4:N8 มีการบันทึกกี่รายการก็ให้คัดลอกข้อมูลไปไว้ที่ชีท AR ไฟล์ AR.Form และชีท Sheet1 ไฟล์ ArBookShare.xlsx ตามจำนวนที่มีการบันทึกที่เซลล์ G4:N8 ค่ะ ปัญหานี้ได้พยายามปรับแล้วค่ะไม่สำเร็จค่ะ ขอรบกวนนะคะ

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")
    With Sheets("Form")
        Set rSource = .Range("B3:B50")
    End With
    With Sheets("Database")
        Set rTarget = .Range("E2", .Range("E" & Rows.Count).End(xlUp))
    End With
    With ActiveSheet
     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 Worksheets("TemBilling")
    Set rSource = .Range("A2:P2").Resize(.Range("Q1"))
    End With
    Sheets("TemBilling").Range("A2:P6").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
    Sheets("TemBilling").Range("P10:W14").Copy
    Sheets("Report").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    Sheets("Form").Range("G4:G8,H1,J2,I4:N8,I6").ClearContents
    With Sheets("Form")
            .Range("J10") = .Range("J10") + 1
        End With
        Application.ScreenUpdating = True
End Sub

[snasui]

ช่วยแจ้งมาด้วยว่า Paste ไม่ได้เนื่องจากติดปัญหาใด โปรแกรมฟ้องว่าอย่างไรหรือไม่ครับ

[suka]

เป็นตามรูปค่ะอาจารย์ ที่ชีท Form บันทึกไว้ 2 รายการ รายการที่ 3-5 หากไม่มีการบันทึกต้องการให้เป็นบรรทัดว่างๆทั้งที่ชีท AR ไฟล์ Formและ Sheet1 ไฟล์ ArBookShare.xlsx เป็นตามนี้ทั้ง 2 ชีทค่ะได้แนบรูปมาหนึ่งตัวอย่างค่ะ

[snasui]

ไม่เข้าใจครับ ลองอ่านที่ผมเขียนถามใหม่อีกรอบครับ ผมถามถึง Code ว่าเป็นปัญหาตรงส่วนใด ก็ให้ตอบว่าเป็นเพราะ Code บรรทัดไหนที่ติดปัญหาหรือบรรทัดไหนที่เขียนแล้วไม่ได้ตามต้องการ เช่นต้องการให้บันทึกชีท A แต่ไปบันทึกที่ชีท B หรือ ไม่บันทึก ฯลฯ

[suka]

ช่วยแจ้งมาด้วยว่า Paste ไม่ได้เนื่องจากติดปัญหาใด โปรแกรมฟ้องว่าอย่างไรหรือไม่ครับ

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

ไม่เข้าใจครับ ลองอ่านที่ผมเขียนถามใหม่อีกรอบครับ ผมถามถึง Code ว่าเป็นปัญหาตรงส่วนใด ก็ให้ตอบว่าเป็นเพราะ Code บรรทัดไหนที่ติดปัญหาหรือบรรทัดไหนที่เขียนแล้วไม่ได้ตามต้องการ เช่นต้องการให้บันทึกชีท A แต่ไปบันทึกที่ชีท B หรือ ไม่บันทึก ฯลฯ

คือ Code Copy นำไปวางถูกตำแหน่งค่ะ แต่ติดปัญหาตรงชีท Form มีเซลล์ G4:N8 ให้ใส่ข้อมูลได้ หากมีเลขที่เช็คที่เซลล์ K4:K8 ครบก็ให้คัดลอกไปทั้ง 5 รายการ แต่หากมีไม่ครบก็ให้นำตามจำนวนที่มีไปวางค่ะ ตัวอย่างไฟล์แนบชีท Form ได้ใส่แค่ 2 รายการค่ะ ไม่เอาบรรทัดที่มีเลขที่เช็คเป็น 0 ไปวางค่ะ ได้ตัด Code ที่เป็นปัญหามาตามนี้ค่ะอาจารย์

Code: Select all

With Worksheets("TemBilling")
    Set rSource = .Range("A2:P2").Resize(.Range("Q1"))
    End With
    Sheets("TemBilling").Range("A2:P6").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
    Sheets("TemBilling").Range("P10:W14").Copy
    Sheets("Report").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues