VBA ก๊อปปี๊สูตรนำมาวางจำนวนบรรทัดเกินต้นฉบับ

[suka]

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

ช่วยเรื่องปรับโค๊ดก๊อปปี๊สูตรและวางเป็นสูตร ปัญหาคือเมื่อวางแล้วจำนวนบรรทัดเกินต้นฉบับค่ะ
ต้นฉบับเซลล์ R10:W25 เท่ากับจำนวน16 บรรทัด ต้องการให้ก๊อปปี๊สูตรมาวางที่เซลล์ G10:L25 ตัวอย่างไฟล์แนบก๊อปบี้มาเกินเซลล์ที่ต้องการ ไม่ทราบต้องปรับโค๊ดอย่างไรค่ะ

Code: Select all

Sub Edit()
        Dim formBook As Workbook
        Dim i As Integer
        Dim rs As Range
        Dim rt As Range
        Set formBook = ThisWorkbook
        
             i = formBook.Worksheets("Sheet3").Range("x9").Value
       With formBook.Worksheets("Sheet3")
            Set rs = .Range(.Range("R10"), .Range("W25" & i + 1))
       End With
            Set rt = formBook.Sheets("Sheet3").Range("G10").End(xlUp).Offset(1, 0)
            rs.Copy: rt.PasteSpecial Paste:=xlPasteFormulas
End Sub

[puriwutpokin]

Code: Select all

Sub Edit()
        Dim formBook As Workbook
        Dim i As Integer
        Dim rs As Range
        Dim rt As Range
        Set formBook = ThisWorkbook
        
             i = formBook.Worksheets("Sheet3").Range("x9").Value
       With formBook.Worksheets("Sheet3")
            Set rs = Range("R10:W25")
       End With
            Set rt = formBook.Sheets("Sheet3").Range("G10").End(xlUp).Offset(1, 0)
            rs.Copy: rt.PasteSpecial Paste:=xlPasteFormulas
End Sub

ลองดูว่าใช่ไหมครับ

[snasui]

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

Code: Select all

With formBook.Sheets("Sheet3")
    i = .Range("x9").Value
    Set rs = .Range("R10:W10").Resize(i)
    Set rt = .Range("G" & .Rows.Count).End(xlUp).Offset(1, 0)
    rs.Copy: rt.PasteSpecial Paste:=xlPasteFormulas
End With

[suka]

ขอบคุณคุณ puriwutpokin ค่ะ โค๊ดสามารถใช้ได้ตรงตามต้องการค่ะ

ขอบคุณอาจารย์ค่ะ ให้อีกหนึ่งตัวอย่างโค๊ดสามารถใช้ได้ตรงตามต้องการค่ะ

ขอบคุณทั้งสองท่านมากๆค่ะ

[suka]

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

Code: Select all

Sub Edit()
        Dim formBook As Workbook
        Dim i As Integer
        Dim rs As Range
        Dim rt As Range
        Set formBook = ThisWorkbook
        
            With formBook.Sheets("Sheet3")
                i = .Range("x9").Value
                Set rs = .Range("R10:W10").Resize(i)
                Set rt = .Range("G10").End(xlUp).Offset(1, 0)
                rs.Copy: rt.PasteSpecial Paste:=xlPasteFormulas
            End With
End Sub

[snasui]

ช่วยแจ้งมาว่า ที่วางทับไม่ได้นั้น โปรแกรมฟ้องว่าอย่างไรหรือไม่ ควรแจ้งสิ่งเหล่านั้นมาด้วยเสมอจะได้วิเคราะห์ในเบื้องต้นได้ครับ

[suka]

โปรแกรมไม่ฟ้องค่ะ แต่นำข้อมูลไปวางที่ด้านบนเริ่มที่เซลล์ G2:L2 ลงมาแทนค่ะ
หากเคลียร์เซลล์ G10:L25 ให้เป็นค่าว่างโปรแกรมสามารถวางข้อมูลที่เซลล์ G10:L25 ได้ตามต้องการค่ะ

[snasui]

โปรแกรมไม่ฟ้องค่ะ แต่นำข้อมูลไปวางที่ด้านบนเริ่มที่เซลล์ G2:L2 ลงมาแทนค่ะ หากเคลียร์เซลล์ G10:L25 ให้เป็นค่าว่างโปรแกรมสามารถวางข้อมูลที่เซลล์ G10:L25 ได้ตามต้องการค่ะ

ที่ผมระบายสีไว้นั้นคือสิ่งสำคัญที่จะเข้าใจได้ทันทีว่าเกิดจากสาเหตุใด

กรณีวางทับตำแหน่งเดิม โดยตำแหน่งนั้นไม่ได้เปลียนแปลงตามการเพิ่มลดข้อมูล ไม่จำเป็นต้องเขียนลักษณะตาม Statement นี้ครับ

Code: Select all

Set rt = .Range("G10").End(xlUp).Offset(1, 0)

เนื่องจากหมายถึงให้เริ่มที่ G10 แล้วเลื่อนไปด้านบนสุดจนเจอที่มีข้อมูลแล้วให้เลื่อนลงมา 1 บรรทัด

กรณีที่ข้อมูลเพิ่มลดอยู่เสมอ การให้เริ่มที่ G10 ตาม Code นี้ย่อมมีโอกาสผิดพลาดสูง ควรปรับให้เป็นตามที่ผมโพสต์ไว้ด้านบน

และหากตำแหน่งการวางแน่นอน เราไม่จำเป็นต้องหาตำแหน่งอีก สามารถระบุตำแหน่งไว้ได้เลย เข่น

Code: Select all

Set rt = .Range("G10")

เป็นต้น

[suka]

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