Viết code cho file chấm công

nguyentheviet86 · 30/7/20

Thân gửi anh chị !
Nhờ anh chị giúp đỡ , viết code vba cho file chấm công
1. Sheet chấm công được lấy từ dữ liệu sheet Data

Lấy dữ liệu từ sheet "Data"
IN	I
OUT	K
WH - D	U
WH - N	V
OVT - D	W
OVT - N	X

Em cảm ơn !

Ba Tê · 30/7/20

nguyentheviet86 đã viết:
Thân gửi anh chị !
Nhờ anh chị giúp đỡ , viết code vba cho file chấm công
1. Sheet chấm công được lấy từ dữ liệu sheet Data

Lấy dữ liệu từ sheet "Data"
IN I
OUT K
WH - D U
WH - N V
OVT - D W
OVT - N X

Em cảm ơn !

- Dữ liệu cột I là lấy cái gì? Nếu lấy Giờ vào thì phải là cột J.
- Thay tên sheet "Chấm công" bằng "ChamCong", không có dấu tiếng Việt, không có dấu cách.
- Các dòng IN, OUT sheet "ChamCong" phải tự Format lại kiểu Time.
- Chạy thử Sub này coi sao nhé.

PHP:

Option Explicit

Public Sub s_Gpe()
Dim Dic As Object, sArr(), dArr(), tArr(), Txt As String
Dim I As Long, J As Long, xRow As Long, yCol As Long, R As Long, RsArr As Long, YtArr As Long
Set Dic = CreateObject("Scripting.Dictionary")
    sArr = Sheets("Data").Range("A2", Sheets("Data").Range("B2").End(xlDown)).Resize(, 24).Value2
    RsArr = UBound(sArr)
With Sheets("ChamCong")
    tArr = .Range("B4", .Range("B4").End(xlDown)).Value2
    R = UBound(tArr)
    For I = 1 To R
        Txt = tArr(I, 1)
        If Not Dic.Exists(Txt) Then Dic.Item(Txt) = I   'Dong bat dau ID'
    Next I
    '--------------------------------------------------'
    tArr = .Range("F3", .Range("F3").End(xlToRight)).Value2
    YtArr = UBound(tArr, 2)
    For J = 1 To YtArr
        Dic.Item(tArr(1, J)) = J    'Cot chua Ngay'
    Next J
    '---------------------------------------------------'
    ReDim dArr(1 To R, 1 To YtArr)
    For I = 1 To RsArr
        If Dic.Exists(sArr(I, 2)) Then
            yCol = Dic.Item(sArr(I, 2))             'Cot Ngay'
            Txt = sArr(I, 3)
            If Dic.Exists(Txt) Then
                xRow = Dic.Item(Txt)                'Dong bat dau ID'
                dArr(xRow, yCol) = sArr(I, 10)      'Lay du lieu Cot J'
                dArr(xRow + 1, yCol) = sArr(I, 11)  'Lay du lieu Cot K'
                dArr(xRow + 2, yCol) = sArr(I, 21)  'Lay du lieu Cot U'
                dArr(xRow + 3, yCol) = sArr(I, 22)  'Lay du lieu Cot V'
                dArr(xRow + 4, yCol) = sArr(I, 23)  'Lay du lieu Cot W'
                dArr(xRow + 5, yCol) = sArr(I, 24)  'Lay du lieu Cot X'
            End If
        End If
    Next I
    .Range("F4").Resize(R, YtArr) = dArr
End With
Set Dic = Nothing
End Sub

nguyentheviet86 · 30/7/20

Ba Tê đã viết:

- Dữ liệu cột I là lấy cái gì? Nếu lấy Giờ vào thì phải là cột J.
- Thay tên sheet "Chấm công" bằng "ChamCong", không có dấu tiếng Việt, không có dấu cách.
- Các dòng IN, OUT sheet "ChamCong" phải tự Format lại kiểu Time.
- Chạy thử Sub này coi sao nhé.

PHP:

Option Explicit

Public Sub s_Gpe()
Dim Dic As Object, sArr(), dArr(), tArr(), Txt As String
Dim I As Long, J As Long, xRow As Long, yCol As Long, R As Long, RsArr As Long, YtArr As Long
Set Dic = CreateObject("Scripting.Dictionary")
    sArr = Sheets("Data").Range("A2", Sheets("Data").Range("B2").End(xlDown)).Resize(, 24).Value2
    RsArr = UBound(sArr)
With Sheets("ChamCong")
    tArr = .Range("B4", .Range("B4").End(xlDown)).Value2
    R = UBound(tArr)
    For I = 1 To R
        Txt = tArr(I, 1)
        If Not Dic.Exists(Txt) Then Dic.Item(Txt) = I   'Dong bat dau ID'
    Next I
    '--------------------------------------------------'
    tArr = .Range("F3", .Range("F3").End(xlToRight)).Value2
    YtArr = UBound(tArr, 2)
    For J = 1 To YtArr
        Dic.Item(tArr(1, J)) = J    'Cot chua Ngay'
    Next J
    '---------------------------------------------------'
    ReDim dArr(1 To R, 1 To YtArr)
    For I = 1 To RsArr
        If Dic.Exists(sArr(I, 2)) Then
            yCol = Dic.Item(sArr(I, 2))             'Cot Ngay'
            Txt = sArr(I, 3)
            If Dic.Exists(Txt) Then
                xRow = Dic.Item(Txt)                'Dong bat dau ID'
                dArr(xRow, yCol) = sArr(I, 10)      'Lay du lieu Cot J'
                dArr(xRow + 1, yCol) = sArr(I, 11)  'Lay du lieu Cot K'
                dArr(xRow + 2, yCol) = sArr(I, 21)  'Lay du lieu Cot U'
                dArr(xRow + 3, yCol) = sArr(I, 22)  'Lay du lieu Cot V'
                dArr(xRow + 4, yCol) = sArr(I, 23)  'Lay du lieu Cot W'
                dArr(xRow + 5, yCol) = sArr(I, 24)  'Lay du lieu Cot X'
            End If
        End If
    Next I
    .Range("F4").Resize(R, YtArr) = dArr
End With
Set Dic = Nothing
End Sub

Anh ơi, có thể cho em xin file không ạ. Em nhập code vào sao không thấy chạy ạ

Ba Tê · 30/7/20

nguyentheviet86 đã viết:
Anh ơi, có thể cho em xin file không ạ. Em nhập code vào sao không thấy chạy ạ

Nhập thế nào mà không chạy?

nguyentheviet86 · 30/7/20

Em cảm ơn anh ạ

nguyentheviet86 · 30/7/20

Ba Tê đã viết:
Nhập thế nào mà không chạy?

Anh ơi, anh có thể giúp em.
1. Sheet Chamcong chỉ lấy đến cột AJ còn từ cột AK trở đi thì em nhập bằng tay ạ
2. Sheet Data từ cột L đến cột Q & từ cột U đến cột AH : Em đang để công thức, anh có thể viết vba giúp em với ạ
Em cảm ơn anh !

Ba Tê · 30/7/20

nguyentheviet86 đã viết:
Anh ơi, anh có thể giúp em.
1. Sheet Chamcong chỉ lấy đến cột AJ còn từ cột AK trở đi thì em nhập bằng tay ạ
2. Sheet Data từ cột L đến cột Q & từ cột U đến cột AH : Em đang để công thức, anh có thể viết vba giúp em với ạ
Em cảm ơn anh !

1. Thay Sub cũ bằng Sub này.
2. Bạn chờ người nào đọc hiểu các công thức của bạn mới chuyển thành VBA được.
Công thức tôi "dở bẹt" nên đọc không hiểu gì.

PHP:

Public Sub s_Gpe()

Const CoL As Long = 31
Dim Dic As Object, sArr(), dArr(), tArr(), Txt As String
Dim I As Long, J As Long, xRow As Long, yCol As Long, R As Long, RsArr As Long
Set Dic = CreateObject("Scripting.Dictionary")
    
    sArr = Sheets("Data").Range("A2", Sheets("Data").Range("B2").End(xlDown)).Resize(, 24).Value2
    RsArr = UBound(sArr)
With Sheets("ChamCong")
    tArr = .Range("B4", .Range("B4").End(xlDown)).Value2
    R = UBound(tArr)
    For I = 1 To R
        Txt = tArr(I, 1)
        If Not Dic.Exists(Txt) Then Dic.Item(Txt) = I   'Dong bat dau ID'
    Next I
    '--------------------------------------------------'
    tArr = .Range("F3").Resize(, CoL).Value2
    For J = 1 To CoL
        Dic.Item(tArr(1, J)) = J    'Cot chua Ngay'
    Next J
    '---------------------------------------------------'
    ReDim dArr(1 To R, 1 To CoL)
    For I = 1 To RsArr
        If Dic.Exists(sArr(I, 2)) Then
            yCol = Dic.Item(sArr(I, 2))             'Cot Ngay'
            Txt = sArr(I, 3)
            If Dic.Exists(Txt) Then
                xRow = Dic.Item(Txt)                'Dong bat dau ID'
                dArr(xRow, yCol) = sArr(I, 10)      'Lay du lieu Cot J'
                dArr(xRow + 1, yCol) = sArr(I, 11)  'Lay du lieu Cot K'
                dArr(xRow + 2, yCol) = sArr(I, 21)  'Lay du lieu Cot U'
                dArr(xRow + 3, yCol) = sArr(I, 22)  'Lay du lieu Cot V'
                dArr(xRow + 4, yCol) = sArr(I, 23)  'Lay du lieu Cot W'
                dArr(xRow + 5, yCol) = sArr(I, 24)  'Lay du lieu Cot X'
            End If
        End If
    Next I
    .Range("F4").Resize(R, CoL) = dArr
End With
Set Dic = Nothing
End Sub

nguyentheviet86 · 2/8/20

Ba Tê đã viết:
Nhập thế nào mà không chạy?

Anh ơi, em muốn lấy thêm cột Y ở sheet Data sang sheet chấm công phải làm sao ạ

anh5giade · 4/10/20

Xin lỗi mọi người, có lẽ tôi hơi khó tính chút, nhưng đọc từ #1 đến #8 thấy chủ topic hình như không biết nhiều về vba ( cá nhân thấy vậy thôi nếu sai thì chấp nhận nhặt gạch) chứ nếu chủ topic mà k rành vba mà xin file vba về dùng thì khổ càng thêm khổ, trong quá trinh sử dụng file sẽ có phát sinh lỗi này nọ, thế là phải vác cái file lên đây để hỏi tiếp á.
Cố gắng nếu được 1 code của các anh chị share thì cố đọc xem có hiểu chút nào không? Nếu không hiểu đoạn nào thì hỏi lại chủ nhân, chứ bê nguyên đoạn code của người ta về mần mà k biết nó làm cái j thì không thể control được đâu ( vì tui cũng k biết vba nên hiểu cảm giác này lắm heee)

SA_DQ · 5/10/20

Thứ nhất: Có file VBA để thực hiện chuyện giải quyết công việc trước mắt là tốt vô kể rồi còn gì.
Kế đến: Nếu người thực tâm vì công việc sẽ có hình mẫu các câu lệnh để tìm tòi & tự học để dần dần khám phá & làm chủ không tốt hay sao?
& tốt nữa: là bí chổ nào trong quá trình tìm hiểu chi tiết thì đưa chi tiết đó lên GPE.COM nhờ diễn dịch, giải nghĩa, không phải qu1a tốt sao?
& cuối cùng là sự phát triển của chương trình luôn có sự đồng hành của nhiều người trên diễn đàn, nếu bạn còn gắn kết thân thương với diễn đàn này,

Chúc các bạn trong cộng đồng luôn khỏe trong tuần làm việc mới!

Viết code cho file chấm công

nguyentheviet86

Thành viên hoạt động

File đính kèm

Ba Tê

Cạo Rồi Khỏi Gội

nguyentheviet86

Thành viên hoạt động

Ba Tê

Cạo Rồi Khỏi Gội

File đính kèm

nguyentheviet86

Thành viên hoạt động

nguyentheviet86

Thành viên hoạt động

File đính kèm

Ba Tê

Cạo Rồi Khỏi Gội

nguyentheviet86

Thành viên hoạt động

anh5giade

Thành viên mới

SA_DQ

/(hông là gì!

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng