:D snasui.com ยินดีต้อนรับ :D
ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย :thup: สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ :arrow: ระบุ Version ของ Excel
:!: โปรดทราบ :!:
  1. กรุณาอ่านกฎการใช้บอร์ด (Forum rules) ในตำแหน่งด้านบนของแต่ละบอร์ด
  2. การสมัครสมาชิก การ Login การกู้คืนรหัสผ่าน
    1. สมัครสมาชิกดูขั้นตอนได้ที่ :arrow: สมัครสมาชิก
    2. Login เข้าระบบโดยคลิกปุ่ม Login ตรงมุมขวาบนของหน้านี้ :roll:
    3. การ Login ผ่าน Facebook ดูวิธีที่ :arrow: Login ผ่าน Facebook
    4. ลืมรหัสผ่านสามารถรับรหัสใหม่ได้ที่ :arrow: Reset รหัสผ่าน
  3. มีปัญหาการใช้งาน แจ้งผู้ดูแลระบบได้ที่ :arrow: ติดต่อผู้ดูแลระบบ
  4. กำหนดการตั้งค่าส่วนตัว เช่นตั้งค่าภาษาเป็นไทยหรืออังกฤษดูได้ที่ :arrow: ตั้งค่าส่วนตัว
  5. การตั้งและตอบกระทู้ดูได้ที่ :arrow: วิธีการตั้งและตอบกระทู้
  6. การจัดรูปแบบตัวอักษรด้วย bbcode ในช่องแสดงความคิดเห็นดูได้ที่ :arrow: จัดรูปแบบตัวอักษร
  7. กำหนดขนาดตัวอักษรใน Browser ดูได้ที่ :arrow: กำหนดขนาดตัวอักษรใน Browser

เขียน VBA เพื่อ Save ไปยัง Sheet อื่น

ฟอรัมถาม-ตอบปัญหาการใช้งาน Macro และ VBA
Forum rules
  1. ไม่อนุญาตให้ใช้ภาษาแชทในการถามและตอบปัญหา ไม่ใช้คำว่า "คับ" หรือ "อ่ะครับ" แทนคำว่า "ครับ" ไม่ใช้คำว่า "เด๋ว" แทนคำว่า "เดี๋ยว" เป็นต้น เนื่องจากเมื่อแปลเป็นภาษาต่างประเทศแล้วจะให้ความหมายผิดไปจากที่ควรจะเป็น
  2. ห้ามถามโดยระบุชื่อผู้ตอบและต้องตั้งชื่อกระทู้ให้สื่อถึงปัญหาที่จะถาม ไม่ตั้งชื่อว่า ช่วยด้วยครับ, มีปัญหามาปรึกษาครับ เป็นต้น
  3. กรุณาอธิบายปัญหาและระบุคำตอบที่ต้องการมาในกระทู้ด้วยเสมอถึงแม้จะอธิบายไว้ในไฟล์แนบแล้วก็ตาม ทั้งนี้เพื่ออำนวยความสะดวกแก่เพื่อนสมาชิกในการค้นหาข้อมูล
  4. กรุณาแนบไฟล์ตัวอย่างพร้อมแสดงคำตอบที่ถูกต้องมาในไฟล์ด้วยเพื่อให้ง่ายต่อการทำความเข้าใจและสะดวกต่อการตอบคำถาม (ขนาดไฟล์ไม่เกิน 500Kb ขนาดภาพไม่เกิน 800*600 Pixel) ไม่แนบเป็น Link มาจากแหล่งอื่นที่อาจจะถูกลบทิ้งไปโดยต้นทางในภายหลัง นอกจากนี้ไม่ควรแนบไฟล์ที่มีข้อมูลสำคัญอันก่อให้เกิดความเสียหายกับตนเองและผู้อื่น
  5. กรณีเป็นคำถามเกี่ยวกับ Programming เช่น VBA, VB.Net, C#, SQL ฯลฯ ต้องลองเขียนมาเองก่อนเสมอ ถามเฉพาะที่ติดปัญหา ระบุ Module, Procedure ที่ติดปัญหาให้ชัดเจน กรุณาโพสต์ Code ให้แสดงเป็น Code คือเปิดด้วย [code] และปิดด้วย [/code] ตัวอย่างเช่น [code]dim r as range[/code] เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
  6. กรุณาแจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
Post Reply
monthikan
Member
Member
Posts: 26
Joined: Mon Mar 04, 2019 2:55 pm

เขียน VBA เพื่อ Save ไปยัง Sheet อื่น

#1

Post by monthikan »

ต้องการเขียน Save ให้ได้หลายๆ รอบ :?:
1. ตอนนี้เขียน Save ใน VBA ได้เเล้วค่ะเเต่มันทำงานได้เเค่รอบเดียว ต้องการเขียน Code ให้ Save ข้อมูลได้หลายๆ รอบโดยอยากให้เวลาที่กดปุ่ม Save Transaction แล้วข้อมูลจะถูก Save ไปที่ sheet : Save เมื่อทำรายการใหม่เพื่อบันทึกข้อมูลตัวใหม่
(Code : SaveStorage)

Code: Select all

Public Sub SaveStorage()
Dim i, r As Integer
Dim Tag, Day, MatCode, Pallet, Des, Quan, Loc, Note, Batch, Who As String

r = 5
    Tag = Sheets(1).Cells(5, 4).Value
    Day = Sheets(1).Cells(5, 7).Value
    MatCode = Sheets(1).Cells(7, 4).Value
    Pallet = Sheets(1).Cells(7, 7).Value
    Des = Sheets(1).Cells(9, 4).Value
    Quan = Sheets(1).Cells(9, 7).Value
    Loc = Sheets(1).Cells(11, 4).Value
    Note = Sheets(1).Cells(11, 7).Value
    Batch = Sheets(1).Cells(13, 4).Value
    Who = Sheets(1).Cells(13, 7).Value
        r = r + 1
            Sheets(3).Cells(r, 1) = Day
            Sheets(3).Cells(r, 2) = Loc
            Sheets(3).Cells(r, 3) = Tag
            Sheets(3).Cells(r, 4) = MatCode
            Sheets(3).Cells(r, 5) = Des
            Sheets(3).Cells(r, 6) = Batch
            Sheets(3).Cells(r, 7) = Pallet
            Sheets(3).Cells(r, 8) = Quan
            Sheets(3).Cells(r, 9) = Who
            Sheets(3).Cells(r, 10) = Note
    End Sub
2. หลังจากการ Save แล้ว เมื่อ Location ใน Sheet : Storage เเละ Sheet : Status ตรงกันให้ทำการบันทึกข้อมูลจาก Sheet : Storage มายัง Sheet : Status โดยทำการบันทึก Tag N./Batch/Qty
(ตอนนี้ Code ที่เขียนได้ยังไม่เเสดงข้อมูลที่หน้า Status)

Code: Select all

Sub myStatus()
    Dim lastrow As String, wb As Workbook
    Dim mylookup As Range, tb As Workbook
    Dim Location(1728, 2), Batch(1728, 4), Qty(1728, 5) As String
    Dim i As Integer
    Dim TagNo(1728, 3) As String
        Set tb = ThisWorkbook
            With tb.Sheets(1)
                lastrow = .Range("D" & .Rows.Count).End(xlUp).Row
            End With
        Set wb = Workbooks.Open("C:\WorkAA\Database\Database.xlsm")
        Set myrange = wb.Sheets(1).Range("A2:L1278")
    On Error Resume Next
        With tb.Sheets(1)
            .Cells(7, 4).Value = Application.WorksheetFunction.VLookup(.[D5], myrange, 7, 0)
            .Cells(9, 4).Value = Application.WorksheetFunction.VLookup(.[D5], myrange, 9, 0)
            .Cells(11, 4).Value = Application.WorksheetFunction.VLookup(.[D5], myrange, 4, 0)
            .Cells(13, 4).Value = Application.WorksheetFunction.VLookup(.[D5], myrange, 10, 0)
            .Cells(7, 7).Value = Application.WorksheetFunction.VLookup(.[D5], myrange, 6, 0)
            .Cells(9, 7).Value = Application.WorksheetFunction.VLookup(.[D5], myrange, 12, 0)
            .Cells(13, 7).Value = Application.WorksheetFunction.VLookup(.[D5], myrange, 5, 0)
            .Cells(5, 7).Value = Application.WorksheetFunction.VLookup(.[D5], myrange, 11, 0)
                With tb.Sheets(4)
                    For i = 1 To 1728
                        Location(i, 2) = Sheets(4).Cells(i + 1, 2).Value
                        TagNo(i, 3) = Sheets(4).Cells(i + 1, 3).Value
                        Batch(i, 4) = Sheets(4).Cells(i + 1, 4).Value
                        Qty(i, 5) = Sheets(4).Cells(i + 1, 5).Value
                    Next i
                         For i = 1 To 1728
                             If Location(i, 2) = Sheets(1).Cells(11, 4).Value Then
                                 TagNo(i, 3) = Sheets(1).Cells(5, 4).Value
                                 Batch(i, 4) = Sheets(1).Cells(13, 4).Value
                                Qty(i, 5) = Sheets(1).Cells(9, 7).Value
                            End If
                         Next i
                End With
        End With
    wb.Close False
End Sub
Attachments
Database.xlsm
(115.41 KiB) Downloaded 13 times
HOMETest1.xlsm
(196.35 KiB) Downloaded 14 times
Top
User avatar
puriwutpokin
Guru
Guru
Posts: 3801
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

Re: เขียน VBA เพื่อ Save ไปยัง Sheet อื่น

#2

Post by puriwutpokin »

ที่

Code: Select all

Public Sub SaveStorage
ตอบข้อแรกก่อนครับ พอดียุ่งนิดหน่อยครับ :D
แทรกโค้ดตามนี้ครับ

Code: Select all

Public Sub SaveStorage()
Dim i, r As Integer
Dim Tag, Day, MatCode, Pallet, Des, Quan, Loc, Note, Batch, Who As String
แทรกด้วยโค้ดนี้

Code: Select all

 r = Sheets(3).Range("a" & Rows.Count).End(xlUp).Row
:shock: :roll: :D
Top
monthikan
Member
Member
Posts: 26
Joined: Mon Mar 04, 2019 2:55 pm

Re: เขียน VBA เพื่อ Save ไปยัง Sheet อื่น

#3

Post by monthikan »

ข้อ 1 แก้ตามนี้ใช้ได้เเล้วค่ะ ขอบคุณนะคะ (แต่ว่าในข้อที่ 2 ยังแก้ไม่ได้ค่ะ)

Code: Select all

Public Sub SaveStorage()
Dim i, r As Integer
Dim Tag, Day, MatCode, Pallet, Des, Quan, Loc, Note, Batch, Who As String
r = Sheets(3).Range("a" & Rows.Count).End(xlUp).Row
    Tag = Sheets(1).Cells(5, 4).Value
    Day = Sheets(1).Cells(5, 7).Value
    MatCode = Sheets(1).Cells(7, 4).Value
    Pallet = Sheets(1).Cells(7, 7).Value
    Des = Sheets(1).Cells(9, 4).Value
    Quan = Sheets(1).Cells(9, 7).Value
    Loc = Sheets(1).Cells(11, 4).Value
    Note = Sheets(1).Cells(11, 7).Value
    Batch = Sheets(1).Cells(13, 4).Value
    Who = Sheets(1).Cells(13, 7).Value
        r = r + 1
            Sheets(3).Cells(r, 1) = Day
            Sheets(3).Cells(r, 2) = Loc
            Sheets(3).Cells(r, 3) = Tag
            Sheets(3).Cells(r, 4) = MatCode
            Sheets(3).Cells(r, 5) = Des
            Sheets(3).Cells(r, 6) = Batch
            Sheets(3).Cells(r, 7) = Pallet
            Sheets(3).Cells(r, 8) = Quan
            Sheets(3).Cells(r, 9) = Who
            Sheets(3).Cells(r, 10) = Note
    End Sub
Top
User avatar
puriwutpokin
Guru
Guru
Posts: 3801
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

Re: เขียน VBA เพื่อ Save ไปยัง Sheet อื่น

#4

Post by puriwutpokin »

monthikan wrote: Thu Mar 07, 2019 4:03 pm ข้อ 1 แก้ตามนี้ใช้ได้เเล้วค่ะ ขอบคุณนะคะ (แต่ว่าในข้อที่ 2 ยังแก้ไม่ได้ค่ะ)

Code: Select all

Public Sub SaveStorage()
Dim i, r As Integer
Dim Tag, Day, MatCode, Pallet, Des, Quan, Loc, Note, Batch, Who As String
r = Sheets(3).Range("a" & Rows.Count).End(xlUp).Row
    Tag = Sheets(1).Cells(5, 4).Value
    Day = Sheets(1).Cells(5, 7).Value
    MatCode = Sheets(1).Cells(7, 4).Value
    Pallet = Sheets(1).Cells(7, 7).Value
    Des = Sheets(1).Cells(9, 4).Value
    Quan = Sheets(1).Cells(9, 7).Value
    Loc = Sheets(1).Cells(11, 4).Value
    Note = Sheets(1).Cells(11, 7).Value
    Batch = Sheets(1).Cells(13, 4).Value
    Who = Sheets(1).Cells(13, 7).Value
        r = r + 1
            Sheets(3).Cells(r, 1) = Day
            Sheets(3).Cells(r, 2) = Loc
            Sheets(3).Cells(r, 3) = Tag
            Sheets(3).Cells(r, 4) = MatCode
            Sheets(3).Cells(r, 5) = Des
            Sheets(3).Cells(r, 6) = Batch
            Sheets(3).Cells(r, 7) = Pallet
            Sheets(3).Cells(r, 8) = Quan
            Sheets(3).Cells(r, 9) = Who
            Sheets(3).Cells(r, 10) = Note
    End Sub
ปรับเป็น

Code: Select all

Public Sub SaveStorage()
Dim i, r As Integer
Dim Tag, Day, MatCode, Pallet, Des, Quan, Loc, Note, Batch, Who As String
 r = Sheets(3).Range("a" & Rows.Count).End(xlUp).Row
    Tag = Sheets(1).Cells(5, 4).Value
    Day = Sheets(1).Cells(5, 7).Value
    MatCode = Sheets(1).Cells(7, 4).Value
    Pallet = Sheets(1).Cells(7, 7).Value
    Des = Sheets(1).Cells(9, 4).Value
    Quan = Sheets(1).Cells(9, 7).Value
    Loc = Sheets(1).Cells(11, 4).Value
    Note = Sheets(1).Cells(11, 7).Value
    Batch = Sheets(1).Cells(13, 4).Value
    Who = Sheets(1).Cells(13, 7).Value
        r = r + 1
            Sheets(3).Cells(r, 1) = Day
            Sheets(3).Cells(r, 2) = Loc
            Sheets(3).Cells(r, 3) = Tag
            Sheets(3).Cells(r, 4) = MatCode
            Sheets(3).Cells(r, 5) = Des
            Sheets(3).Cells(r, 6) = Batch
            Sheets(3).Cells(r, 7) = Pallet
            Sheets(3).Cells(r, 8) = Quan
            Sheets(3).Cells(r, 9) = Who
            Sheets(3).Cells(r, 10) = Note
             i = Application.WorksheetFunction.Match(Sheets(1).Cells(11, 4), Sheets(4).Range("B2:B1728"), 0) + 1
            Sheets(4).Cells(i, 3).Value = Sheets(1).Cells(5, 4).Value
            Sheets(4).Cells(i, 4).Value = Sheets(1).Cells(13, 4).Value
            Sheets(4).Cells(i, 5).Value = Sheets(1).Cells(9, 7).Value
    End Sub
:shock: :roll: :D
Top
monthikan
Member
Member
Posts: 26
Joined: Mon Mar 04, 2019 2:55 pm

Re: เขียน VBA เพื่อ Save ไปยัง Sheet อื่น

#5

Post by monthikan »

แก้ไขเเล้ว ใช่ได้เเล้วค่ะ ขอบคุณค่ะ :D :thup:
Top
Post Reply

Return to “Excel Macro & VBA”