VBA. UPDATE ข้อมูลเพิ่ม

[liveday]

เรียนอาจารย์ทุกท่านครับ

จะต้องแก้สูตรยังไง เพื่อให้ข้อมูลเพิ่มใน (Sheet ทำรูปแบบพิมพ์ใบปะหน้า) ต่อจากข้อมูลเดิมได้เลยครับ

ขอบคุณครับ

[DhitiBank]

ขั้นตอนการทำงานของไฟล์นี้เป็นยังไงครับ รบกวนอธิบายคร่าวๆ ได้ไหม เช่น คีย์ข้อมูลใน Sheet1 หลังจากกดปุ่มแล้ว ให้โค้ดไปเช็คข้อมูลใน ชีท KTB โดยดูจากเซลล์นั้นเซลล์นี้ หากเงื่อนไขเป็นอย่างนั้นอย่างนี้ ก็ให้เอาข้อมูลไปวางไว้ในชีทใบปะหน้าโดยเรียงจากซ้ายไปขวาตามแบบฟอร์มลงไปเรื่อยๆ โดยไม่ลบข้อมูลเดิมออก แต่ว่าโค้ดตอนนี้ไม่ได้ตามต้องการตรงที่มันเป็นอย่างนั้นอย่างนี้ ฯลฯ

หรือขั้นตอนเป็นอย่างอื่นก็อธิบายมาพอสังเขป จะได้เข้าใจตรงกันครับ

[liveday]

ขั้นตอนแรกในชีท KTB ผมต้องคีย์ข้อมูลเพิ่มไปเรื่อยๆ ส่วนใน Sheet1 นั้นจะเป็นแบบฟอร์มครับเพื่อให้เราได้เห็นแบบฟอร์มจดหมาย เมื่อเรากดบันทึกใน Sheet1 นั้น ข้อมูลที่ชีท KTB จะถูกส่งไปที่ ชีท ทำรูปแบบพิมพ์ใบปะหน้า พอกดบันทึกที่ชีท Sheet1 เสร็จแล้วข้อมูลจะเริ่มใหม่หมดเลย เราสามารถทำให้เพิ่ม ที่ ชีท ทำรูปแบบพิมพ์ใบปะหน้า โดยข้อมูลเก่าไม่ลบออกได้ไหมครับ ปัญหาหลักๆคือ ชีท ทำรูปแบบพิมพ์ใบปะหน้า ข้อมูลรายชื่อบางคนหรือที่อยู่ยาวมาก ผมต้องมาแก้บรรทัดใหม่ที่ ชีท ทำรูปแบบพิมพ์ใบปะหน้าก่อนออกงานพิมพ์ครับ

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Public Sub EnvelopePaste()
    Dim rSource As Range
    Dim rTarget As Range
    Dim i As Long, j As Long
    Dim stCol As Byte
    Application.ScreenUpdating = False
    With Sheets("·ÓÃٻẺ¾ÔÁ¾ì㺻Ð˹éÒ")
        .Range("A:O").UnMerge
        '.Range("A:O").ClearContents
        If .Range("a1").Value = "" Then
            stCol = 1
            j = 1
        ElseIf .Range("b" & .Rows.Count).End(xlUp) = "" Then
            stCol = 1
            j = .Range("b" & .Rows.Count).End(xlUp).Row - 4
        Else
            stCol = 7
            j = .Range("i" & .Rows.Count).End(xlUp).Row - 4
        End If
    End With
    Set rSource = Sheets("Sheet1").Range("A1:G5")
    'j = 1
    For i = 1 To 10000 Step 2
        Sheets("Sheet1").Range("H1") = i
        If Sheets("KTB").Range("B" & i + 1) = "" Then Exit For
        With Sheets("·ÓÃٻẺ¾ÔÁ¾ì㺻Ð˹éÒ")
            Set rTarget = .Range(.Range("A" & j), .Range("G" & j + 4))
    '        End With
            If stCol = 1 Then
                rSource.Copy
                rTarget.PasteSpecial xlPasteValues
                rTarget.PasteSpecial xlPasteFormats
                Sheets("Sheet1").Range("H1") = i + 1
                rSource.Copy
                rTarget.Offset(0, 7).PasteSpecial xlPasteValues
                rTarget.Offset(0, 7).PasteSpecial xlPasteFormats
                j = j + 5
            Else
                rSource.Copy
                rTarget.Offset(0, 7).PasteSpecial xlPasteValues
                rTarget.Offset(0, 7).PasteSpecial xlPasteFormats
                j = j + 5
                Set rTarget = .Range(.Range("A" & j), .Range("G" & j + 4))
                Sheets("Sheet1").Range("H1") = i + 1
                rSource.Copy
                rTarget.PasteSpecial xlPasteValues
                rTarget.PasteSpecial xlPasteFormats
            End If
        End With
    Next i
    Application.CutCopyMode = False
    MsgBox "Finish"
    Application.ScreenUpdating = True
End Sub