Page 1 of 1

รบกวนดูสูตร VBA ด้วยน่ะครับ

Posted: Sat Mar 23, 2019 4:11 pm
by art2523
ผมต้องการ คัดลอกข้อมูลจาก Sheet "DailSaleCredit" ไปยัง Sheet "Data" โดยบันทึกให้ต่อข้อมูลที่มีอยู่ใน sheet "data"แล้วให้รันไปเรื่อยๆ และเมื่อกด Submit แล้วของมูลใน DailSaleCredit เป็นหน้าว่างได้ไหมครับ ผมลองเขียนสูตรแล้ว มีปัญหาที่ต่อท้ายแต่ มีช่องว่างผมควรแก้ไขสูตรยังไงดีครับ

Code: Select all

Sub seveDatat()
Dim s As Range
Dim tg As Range
    With Sheets("data")
        With .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0)
        If IsNumeric(.Offset(-1, -1)) Then
         .Offset(0, -1).Value = .Offset(-1, -1).Value + 1
        Else
            .Offset(0, -1).Value = 1
        End If
        Set s = Worksheets("DailSaleCredit").Range("G3:R74")
        Set tg = Worksheets("Data").Range("A65536").End(xlUp).Offset(1, 0)
s.Copy
tg.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
    End With

End Sub

Re: รบกวนดูสูตร VBA ด้วยน่ะครับ

Posted: Sat Mar 23, 2019 5:42 pm
by puriwutpokin
art2523 wrote: Sat Mar 23, 2019 4:11 pm ผมต้องการ คัดลอกข้อมูลจาก Sheet "DailSaleCredit" ไปยัง Sheet "Data" โดยบันทึกให้ต่อข้อมูลที่มีอยู่ใน sheet "data"แล้วให้รันไปเรื่อยๆ และเมื่อกด Submit แล้วของมูลใน DailSaleCredit เป็นหน้าว่างได้ไหมครับ ผมลองเขียนสูตรแล้ว มีปัญหาที่ต่อท้ายแต่ มีช่องว่างผมควรแก้ไขสูตรยังไงดีครับ

Code: Select all

Sub seveDatat()
Dim s As Range
Dim tg As Range
    With Sheets("data")
        With .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0)
        If IsNumeric(.Offset(-1, -1)) Then
         .Offset(0, -1).Value = .Offset(-1, -1).Value + 1
        Else
            .Offset(0, -1).Value = 1
        End If
        Set s = Worksheets("DailSaleCredit").Range("G3:R74")
        Set tg = Worksheets("Data").Range("A65536").End(xlUp).Offset(1, 0)
s.Copy
tg.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
    End With

End Sub
ควรแนบไฟล์ตัวอย่างมาด้วยนะครับ ตามกฏเว็บนี้ครับ
เบื้องต้นลองปรับตามนี้จาก

Code: Select all

 .Offset(0, -1).Value = .Offset(-1, -1).Value + 1
        Else
            .Offset(0, -1).Value = 1
        End If
เป็น

Code: Select all

' Other code...
         .Offset(0, 1).Value = .Offset(-1, -1).Value
        Else
            .Offset(0, -1).Value = 1
        End If
 ' Other code...
ปรับตรงนี้เพิ่มลบข้อมูลเก่า

Code: Select all

tg.PasteSpecial xlPasteValues
   s.ClearContents
    Range("G3").Select
Application.CutCopyMode = False

Re: รบกวนดูสูตร VBA ด้วยน่ะครับ

Posted: Sat Mar 23, 2019 9:42 pm
by art2523
ขอโทษครับที่ลืม

Re: รบกวนดูสูตร VBA ด้วยน่ะครับ

Posted: Sat Mar 23, 2019 9:49 pm
by puriwutpokin
แล้วโค้ดที่ให้แก้ ได้แก้ไขยังครับ และผมดูแล้วไม่เห็น โค้ดที่โพสไว้เลยครับ ลองทำตามที่แจ้งไปว่าได้หรือติดตรงไหนหรือไม่ครับ

Re: รบกวนดูสูตร VBA ด้วยน่ะครับ

Posted: Sat Mar 23, 2019 10:31 pm
by art2523

Code: Select all

Set s = Worksheets("DailSaleCredit").Range("G3:R74")

โค้ดตรงนี้เราสามารถแก้ไขได้อย่างไงครับ Range("G3:R3") เพราะข้อมูลบ้างครั้งมีมากมีน้อยครับ

Re: รบกวนดูสูตร VBA ด้วยน่ะครับ

Posted: Sat Mar 23, 2019 10:51 pm
by puriwutpokin
art2523 wrote: Sat Mar 23, 2019 10:31 pm

Code: Select all

Set s = Worksheets("DailSaleCredit").Range("G3:R74")

โค้ดตรงนี้เราสามารถแก้ไขได้อย่างไงครับ Range("G3:R3") เพราะข้อมูลบ้างครั้งมีมากมีน้อยครับ
ปรับเป็นตามนีดูครับ :D

Code: Select all

Sub RecordData()
Dim s, tg As Range
Dim r As Integer
    With Sheets("DailSaleCredit")
              r = .Cells(.Rows.Count, "g").End(xlUp).Row
        Set s = Worksheets("DailSaleCredit").Range("g3:r" & r)
        Set tg = Worksheets("Data").Range("A65536").End(xlUp).Offset(1, 0)
s.Copy
tg.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
End Sub