Page 1 of 1

test วาง Code VBA

Posted: Thu May 19, 2022 9:12 pm
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


Re: test วาง Code VBA

Posted: Thu May 19, 2022 9:12 pm
by noisuree
D: ทดสอบ

Re: test วาง Code VBA

Posted: Thu May 19, 2022 9:14 pm
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