: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

test วาง Code VBA

ฟอรัมสำหรับการทดสอบโพสต์
Post Reply
noisuree
Member
Member
Posts: 19
Joined: Mon Jun 10, 2013 10:47 pm

test วาง Code VBA

#1

Post by noisuree »

Code: Select all

Sub Click11112()
    Dim i, Lr, x As Long
    Dim myArr() As Variant
        With Sheets("Sheet1")
            If .Range("A1").Value = "" Then MsgBox "โปรดระบุข้อมูลให้ครบถ้วน", vbCritical + vbOKOnly, "แจ้งเตือน": Exit Sub
            Lr = .Range("A" & .Rows.Count).End(xlUp).Row
            ReDim myArr(0 To Lr, 0 To 10)
                For j = 0 To 10
                    myArr(0, j) = .Range("A1").Offset(, j)
                Next j
                
                x = 1
                For i = 3 To Lr
                    If .Range("F" & i) = "พนักงานผลิต 1" Then
                        For j = 0 To 10
                            myArr(x, j) = .Cells(i, j + 1)
                        Next j
                        x = x + 1
                    End If
                Next i
        End With
        With Sheets("Emp1")
            .Cells.ClearContents
            .Range("A1").Resize(x, UBound(myArr, 2)) = myArr
        End With
        MsgBox "บันทึกรายการเรียบร้อยแล้ว ", vbInformation + vbOKOnly, "แจ้งให้ทราบ"
End Sub

noisuree
Member
Member
Posts: 19
Joined: Mon Jun 10, 2013 10:47 pm

Re: test วาง Code VBA

#2

Post by noisuree »

D: ทดสอบ
noisuree
Member
Member
Posts: 19
Joined: Mon Jun 10, 2013 10:47 pm

Re: test วาง Code VBA

#3

Post by noisuree »

test test

Code: Select all

Sub Click11112()
    Dim i, Lr, x As Long
    Dim myArr() As Variant
        With Sheets("Sheet1")
            If .Range("A1").Value = "" Then MsgBox "โปรดระบุข้อมูลให้ครบถ้วน", vbCritical + vbOKOnly, "แจ้งเตือน": Exit Sub
            Lr = .Range("A" & .Rows.Count).End(xlUp).Row
            ReDim myArr(0 To Lr, 0 To 10)
                For j = 0 To 10
                    myArr(0, j) = .Range("A1").Offset(, j)
                Next j
                
                x = 1
                For i = 3 To Lr
                    If .Range("F" & i) = "พนักงานผลิต 1" Then
                        For j = 0 To 10
                            myArr(x, j) = .Cells(i, j + 1)
                        Next j
                        x = x + 1
                    End If
                Next i
        End With
        With Sheets("Emp1")
            .Cells.ClearContents
            .Range("A1").Resize(x, UBound(myArr, 2)) = myArr
        End With
        MsgBox "บันทึกรายการเรียบร้อยแล้ว ", vbInformation + vbOKOnly, "แจ้งให้ทราบ"
End Sub

Post Reply