Làm sổ cấp giấy chứng nhận. (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
baquang1984

baquang1984

Thành viên tiêu biểu
Tham gia
3/6/10
Bài viết
429
Được thích
44
Nghề nghiệp
Kỹ sư Lâm nghiệp
Em có một bảng dữ liệu, từ bảng dữ liệu này tạo thành một sổ cấp giấy như file đính kèm nhưng em không biết nhiều về Code VBA nên để thuận tiện cho công việc của mình nhờ anh chị trên diễn đàn giúp đỡ tạo code giúp ạ
Em cảm ơn mọi người!
 
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
baquang1984 đã viết:
Em có một bảng dữ liệu, từ bảng dữ liệu này tạo thành một sổ cấp giấy như file đính kèm nhưng em không biết nhiều về Code VBA nên để thuận tiện cho công việc của mình nhờ anh chị trên diễn đàn giúp đỡ tạo code giúp ạ
Em cảm ơn mọi người!
Nhấp chuột vào đây để mở rộng...
Xem thử File này, bạn tự kẻ khung màu mè.
 

File đính kèm

Upvote 0
Em cảm ơn anh Ba Tê nhưng mà chương chình lấy số vào sổ còn thiều anh ạ bởi vì mỗi hộ có một số phát hành khác nhau nhưng số vào sổ có thể là 1 anh xem lại giúp em ở Sheet1 với với hộ Ông Hoàng Dàu Vảng số vào sổ là CH01122 tuy nhiên số phát hành là BS 938033 -> BS 938040 anh làm thế nào để nó chạy hết cho các hộ được không ạ
Cảm ơn anh nhiều!
Ba Tê đã viết:
Xem thử File này, bạn tự kẻ khung màu mè.
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
baquang1984 đã viết:
Em cảm ơn anh Ba Tê nhưng mà chương chình lấy số vào sổ còn thiều anh ạ bởi vì mỗi hộ có một số phát hành khác nhau nhưng số vào sổ có thể là 1 anh xem lại giúp em ở Sheet1 với với hộ Ông Hoàng Dàu Vảng số vào sổ là CH01122 tuy nhiên số phát hành là BS 938033 -> BS 938040 anh làm thế nào để nó chạy hết cho các hộ được không ạ
Cảm ơn anh nhiều!
Nhấp chuột vào đây để mở rộng...
Nếu vậy thì code còn ngắn gọn hơn nữa.
Thay Sub này thế cho Sub cũ trong Module thử xem:
PHP: 
Public Sub GPE()
Dim sArr(), dArr(), I As Long, K As Long, Ong As String, Ba As String
Dim Thon As String, Xa As String, Huyen As String, Tinh As String
With Sheet1
    sArr = .Range(.[A2], .[A65536].End(xlUp)).Resize(, 9).Value
    Ong = .[L1].Value: Ba = .[L2].Value: Thon = .[L3].Value
    Xa = .[E1].Value: Huyen = .[F1].Value: Tinh = .[G1].Value
End With
ReDim dArr(1 To UBound(sArr, 1) * 4, 1 To 4)
For I = 1 To UBound(sArr, 1)
    K = K + 1
        dArr(K, 1) = sArr(I, 1)
        dArr(K, 2) = Ong & sArr(I, 2) & " " & Ba & sArr(I, 3)
        dArr(K, 3) = sArr(I, 8): dArr(K, 4) = sArr(I, 9)
    K = K + 1: dArr(K, 2) = Thon & sArr(I, 4) & ", " & Xa & " " & sArr(I, 5)
    K = K + 1: dArr(K, 2) = Huyen & sArr(I, 6) & ", " & Tinh & " " & sArr(I, 7)
    K = K + 1
Next I
With Sheet2
    .[A4].Resize(K, 4).Value = dArr
End With
End Sub
 
Upvote 0
Em cảm ơn bác Ba Tê nhiều nhé đúng là Cao thủ
Ba Tê đã viết:
Nếu vậy thì code còn ngắn gọn hơn nữa.
Thay Sub này thế cho Sub cũ trong Module thử xem:
PHP: 
Public Sub GPE()
Dim sArr(), dArr(), I As Long, K As Long, Ong As String, Ba As String
Dim Thon As String, Xa As String, Huyen As String, Tinh As String
With Sheet1
    sArr = .Range(.[A2], .[A65536].End(xlUp)).Resize(, 9).Value
    Ong = .[L1].Value: Ba = .[L2].Value: Thon = .[L3].Value
    Xa = .[E1].Value: Huyen = .[F1].Value: Tinh = .[G1].Value
End With
ReDim dArr(1 To UBound(sArr, 1) * 4, 1 To 4)
For I = 1 To UBound(sArr, 1)
    K = K + 1
        dArr(K, 1) = sArr(I, 1)
        dArr(K, 2) = Ong & sArr(I, 2) & " " & Ba & sArr(I, 3)
        dArr(K, 3) = sArr(I, 8): dArr(K, 4) = sArr(I, 9)
    K = K + 1: dArr(K, 2) = Thon & sArr(I, 4) & ", " & Xa & " " & sArr(I, 5)
    K = K + 1: dArr(K, 2) = Huyen & sArr(I, 6) & ", " & Tinh & " " & sArr(I, 7)
    K = K + 1
Next I
With Sheet2
    .[A4].Resize(K, 4).Value = dArr
End With
End Sub
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
Anh Ba Tê cho em nhờ thêm chút nữa là em muốn làm một công cụ để tổng hợp dữ liệu từ nhiều file excel nhưng mà có chung định dạng các cột em muốn tổng hợp vào một Sheet (Data) ở file excel khác anh và mọi người giúp em với nhé
Thanks
Ba Tê đã viết:
Nếu vậy thì code còn ngắn gọn hơn nữa.
Thay Sub này thế cho Sub cũ trong Module thử xem:
PHP: 
Public Sub GPE()
Dim sArr(), dArr(), I As Long, K As Long, Ong As String, Ba As String
Dim Thon As String, Xa As String, Huyen As String, Tinh As String
With Sheet1
    sArr = .Range(.[A2], .[A65536].End(xlUp)).Resize(, 9).Value
    Ong = .[L1].Value: Ba = .[L2].Value: Thon = .[L3].Value
    Xa = .[E1].Value: Huyen = .[F1].Value: Tinh = .[G1].Value
End With
ReDim dArr(1 To UBound(sArr, 1) * 4, 1 To 4)
For I = 1 To UBound(sArr, 1)
    K = K + 1
        dArr(K, 1) = sArr(I, 1)
        dArr(K, 2) = Ong & sArr(I, 2) & " " & Ba & sArr(I, 3)
        dArr(K, 3) = sArr(I, 8): dArr(K, 4) = sArr(I, 9)
    K = K + 1: dArr(K, 2) = Thon & sArr(I, 4) & ", " & Xa & " " & sArr(I, 5)
    K = K + 1: dArr(K, 2) = Huyen & sArr(I, 6) & ", " & Tinh & " " & sArr(I, 7)
    K = K + 1
Next I
With Sheet2
    .[A4].Resize(K, 4).Value = dArr
End With
End Sub
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
baquang1984 đã viết:
Anh Ba Tê cho em nhờ thêm chút nữa là em muốn làm một công cụ để tổng hợp dữ liệu từ nhiều file excel nhưng mà có chung định dạng các cột em muốn tổng hợp vào một Sheet (Data) ở file excel khác anh và mọi người giúp em với nhé
Thanks
Nhấp chuột vào đây để mở rộng...
Chắc bạn biết Remove or Copy Sheet?
Có bi nhiêu file thì copy sheet vào chung file tổng hơp, bấm nút 1 phát.
Để nhiều file bạn lại "lung tung" lên phiền phức (Tên file, File mở hay chưa, Folder chứa file, Tên sheet....)
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Vâng em cảm ơn anh Ba Tê nhưng khi tổng hợp dữ liệu em chỉ muốn tổng hợp ở những Sheet có đĩnh dạng tên Sheet là File1, File2, ... được không ạ mong anh giúp em ạ
Thanks
Ba Tê đã viết:
Chắc bạn biết Remove or Copy Sheet?
Có bi nhiêu file thì copy sheet vào chung file tổng hơp, bấm nút 1 phát.
Để nhiều file bạn lại "lung tung" lên phiền phức (Tên file, File mở hay chưa, Folder chứa file, Tên sheet....)
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
baquang1984 đã viết:
Vâng em cảm ơn anh Ba Tê nhưng khi tổng hợp dữ liệu em chỉ muốn tổng hợp ở những Sheet có đĩnh dạng tên Sheet là File1, File2, ... được không ạ mong anh giúp em ạ
Thanks
Nhấp chuột vào đây để mở rộng...
Vậy thì thay Sub cũ bằng Sub này, Sheet nào tên có 4 ký tự đầu tiên là "File" thì tổng hợp, các sheet khác thì bỏ qua.
Nhớ là cấu trúc dòng (tiêu đề), cột phải giống nhau.
PHP: 
Public Sub TongHop_GPE()
Application.ScreenUpdating = False
Dim sArr(), dArr(1 To 65000, 1 To 6), tArr(), I As Long, J As Long, K As Long, Ws As Worksheet
tArr = Sheets("TongHop").[A2:F2].Value
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name Like "File*" Then
        sArr = Ws.Range(Ws.[A2], Ws.[A65536].End(xlUp)).Resize(, 25).Value
        For I = 1 To UBound(sArr, 1)
            K = K + 1
            For J = 1 To 6
                dArr(K, J) = sArr(I, tArr(1, J))
            Next J
        Next I
    End If
Next Ws
With Sheets("TongHop")
    .[A3:F10000].ClearContents
    .[A3:F10000].Borders.LineStyle = xlNone
    .[A3].Resize(K, 6).Value = dArr
    .[A3].Resize(K, 6).Borders.LineStyle = xlContinuous
End With
End Sub
 
Upvote 0
Em cảm ơn bác Ba Tê bác đúng là cao thủ
Ba Tê đã viết:
Vậy thì thay Sub cũ bằng Sub này, Sheet nào tên có 4 ký tự đầu tiên là "File" thì tổng hợp, các sheet khác thì bỏ qua.
Nhớ là cấu trúc dòng (tiêu đề), cột phải giống nhau.
PHP: 
Public Sub TongHop_GPE()
Application.ScreenUpdating = False
Dim sArr(), dArr(1 To 65000, 1 To 6), tArr(), I As Long, J As Long, K As Long, Ws As Worksheet
tArr = Sheets("TongHop").[A2:F2].Value
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name Like "File*" Then
        sArr = Ws.Range(Ws.[A2], Ws.[A65536].End(xlUp)).Resize(, 25).Value
        For I = 1 To UBound(sArr, 1)
            K = K + 1
            For J = 1 To 6
                dArr(K, J) = sArr(I, tArr(1, J))
            Next J
        Next I
    End If
Next Ws
With Sheets("TongHop")
    .[A3:F10000].ClearContents
    .[A3:F10000].Borders.LineStyle = xlNone
    .[A3].Resize(K, 6).Value = dArr
    .[A3].Resize(K, 6).Borders.LineStyle = xlContinuous
End With
End Sub
Nhấp chuột vào đây để mở rộng...
 
Lần chỉnh sửa cuối:
Upvote 0
Anh Ba Tê ạ khi mà tổng hợp dữ liệu sang Sheet mới như vậy anh có thể tích hợp thêm cho em nó tự động Sort theo (CQL1 và Địa chỉ chủ sử dụng) được không ạ
Em cảm ơn anh nhiều! Làm phiền bác quá
Ba Tê đã viết:
Vậy thì thay Sub cũ bằng Sub này, Sheet nào tên có 4 ký tự đầu tiên là "File" thì tổng hợp, các sheet khác thì bỏ qua.
Nhớ là cấu trúc dòng (tiêu đề), cột phải giống nhau.
PHP: 
Public Sub TongHop_GPE()
Application.ScreenUpdating = False
Dim sArr(), dArr(1 To 65000, 1 To 6), tArr(), I As Long, J As Long, K As Long, Ws As Worksheet
tArr = Sheets("TongHop").[A2:F2].Value
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name Like "File*" Then
        sArr = Ws.Range(Ws.[A2], Ws.[A65536].End(xlUp)).Resize(, 25).Value
        For I = 1 To UBound(sArr, 1)
            K = K + 1
            For J = 1 To 6
                dArr(K, J) = sArr(I, tArr(1, J))
            Next J
        Next I
    End If
Next Ws
With Sheets("TongHop")
    .[A3:F10000].ClearContents
    .[A3:F10000].Borders.LineStyle = xlNone
    .[A3].Resize(K, 6).Value = dArr
    .[A3].Resize(K, 6).Borders.LineStyle = xlContinuous
End With
End Sub
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
baquang1984 đã viết:
Anh Ba Tê ạ khi mà tổng hợp dữ liệu sang Sheet mới như vậy anh có thể tích hợp thêm cho em nó tự động Sort theo (CQL1 và Địa chỉ chủ sử dụng) được không ạ
Em cảm ơn anh nhiều! Làm phiền bác quá
Nhấp chuột vào đây để mở rộng...
Nói rõ đi. Cái nào ưu tiên 1, cái nào ưu tiên 2?
 
Upvote 0
baquang1984 đã viết:
Cái ưu tiên là Địa chỉ Chủ sử dụng, sau đó đến CQL1 anh ạ
Thanks anh!
Nhấp chuột vào đây để mở rộng...
Chừng nào mới hết "tích hợp thêm" nữa?
PHP: 
Public Sub TongHop_GPE()
Application.ScreenUpdating = False
Dim sArr(), dArr(1 To 65000, 1 To 6), tArr(), I As Long, J As Long, K As Long, Ws As Worksheet
tArr = Sheets("TongHop").[A2:F2].Value
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name Like "File*" Then
        sArr = Ws.Range(Ws.[A2], Ws.[A65536].End(xlUp)).Resize(, 25).Value
        For I = 1 To UBound(sArr, 1)
            K = K + 1
            For J = 1 To 6
                dArr(K, J) = sArr(I, tArr(1, J))
            Next J
        Next I
    End If
Next Ws
With Sheets("TongHop")
    .[A3:F10000].ClearContents
    .[A3:F10000].Borders.LineStyle = xlNone
    .[A3].Resize(K, 6).Value = dArr
    .[A3].Resize(K, 6).Sort Key1:=.[D3], Order1:=xlAscending, Key2:=.[B3], Order2:=xlAscending
    .[A3].Resize(K, 6).Borders.LineStyle = xlContinuous
End With
End Sub
 
Upvote 0
Cảm ơn bác nhiều tại em gà về khoản này nên làm phiền bác quá
Cảm ơn bác Ba Tê nhé!
Ba Tê đã viết:
Chừng nào mới hết "tích hợp thêm" nữa?
PHP: 
Public Sub TongHop_GPE()
Application.ScreenUpdating = False
Dim sArr(), dArr(1 To 65000, 1 To 6), tArr(), I As Long, J As Long, K As Long, Ws As Worksheet
tArr = Sheets("TongHop").[A2:F2].Value
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name Like "File*" Then
        sArr = Ws.Range(Ws.[A2], Ws.[A65536].End(xlUp)).Resize(, 25).Value
        For I = 1 To UBound(sArr, 1)
            K = K + 1
            For J = 1 To 6
                dArr(K, J) = sArr(I, tArr(1, J))
            Next J
        Next I
    End If
Next Ws
With Sheets("TongHop")
    .[A3:F10000].ClearContents
    .[A3:F10000].Borders.LineStyle = xlNone
    .[A3].Resize(K, 6).Value = dArr
    .[A3].Resize(K, 6).Sort Key1:=.[D3], Order1:=xlAscending, Key2:=.[B3], Order2:=xlAscending
    .[A3].Resize(K, 6).Borders.LineStyle = xlContinuous
End With
End Sub
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
Em chào anh anh Ba Tê em nhờ anh giúp đỡ tạo chường trình xuất biểu sổ địa chính hiện tai em đang làm một sổ ĐC để quản lý sổ bìa đỏ của các hộ GĐ khi tạo sổ như thế này em đã nghĩ đến làm bằng công cụ PivotTable tuy nhiên làm thủ công từng hộ một thì lâu quá. Em muốn nhờ anh chị của GPE Code VBA giúp em để khi em tạo được cho tất cả các Hộ GĐ.
Ở đây sẽ tạo theo cột CMND1, nếu các hộ có CMND1 thì tạo còn không thì không tạo và tạo theo mẫu và dữ liệu đính kèm
Em xin cảm ơn gia đình GPE
Mong được anh giúp đỡ
Thanks
Ba Tê đã viết:
Chừng nào mới hết "tích hợp thêm" nữa?
PHP: 
Public Sub TongHop_GPE()
Application.ScreenUpdating = False
Dim sArr(), dArr(1 To 65000, 1 To 6), tArr(), I As Long, J As Long, K As Long, Ws As Worksheet
tArr = Sheets("TongHop").[A2:F2].Value
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name Like "File*" Then
        sArr = Ws.Range(Ws.[A2], Ws.[A65536].End(xlUp)).Resize(, 25).Value
        For I = 1 To UBound(sArr, 1)
            K = K + 1
            For J = 1 To 6
                dArr(K, J) = sArr(I, tArr(1, J))
            Next J
        Next I
    End If
Next Ws
With Sheets("TongHop")
    .[A3:F10000].ClearContents
    .[A3:F10000].Borders.LineStyle = xlNone
    .[A3].Resize(K, 6).Value = dArr
    .[A3].Resize(K, 6).Sort Key1:=.[D3], Order1:=xlAscending, Key2:=.[B3], Order2:=xlAscending
    .[A3].Resize(K, 6).Borders.LineStyle = xlContinuous
End With
End Sub
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
Anh Ba Tê và mọi người của GPE giúp em chương trình này với ạ nếu làm thủ công bằng PivotTable để in cho từng hộ một thì lâu qua em lại phải làm cả 1 huyện huuuu
Mọi người cùng giúp em với Thanks
baquang1984 đã viết:
Em chào anh anh Ba Tê em nhờ anh giúp đỡ tạo chường trình xuất biểu sổ địa chính hiện tai em đang làm một sổ ĐC để quản lý sổ bìa đỏ của các hộ GĐ khi tạo sổ như thế này em đã nghĩ đến làm bằng công cụ PivotTable tuy nhiên làm thủ công từng hộ một thì lâu quá. Em muốn nhờ anh chị của GPE Code VBA giúp em để khi em tạo được cho tất cả các Hộ GĐ.
Ở đây sẽ tạo theo cột CMND1, nếu các hộ có CMND1 thì tạo còn không thì không tạo và tạo theo mẫu và dữ liệu đính kèm
Em xin cảm ơn gia đình GPE
Mong được anh giúp đỡ
Thanks
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
baquang1984 đã viết:
Em chào anh anh Ba Tê em nhờ anh giúp đỡ tạo chường trình xuất biểu sổ địa chính hiện tai em đang làm một sổ ĐC để quản lý sổ bìa đỏ của các hộ GĐ khi tạo sổ như thế này em đã nghĩ đến làm bằng công cụ PivotTable tuy nhiên làm thủ công từng hộ một thì lâu quá. Em muốn nhờ anh chị của GPE Code VBA giúp em để khi em tạo được cho tất cả các Hộ GĐ.
Ở đây sẽ tạo theo cột CMND1, nếu các hộ có CMND1 thì tạo còn không thì không tạo và tạo theo mẫu và dữ liệu đính kèm
Em xin cảm ơn gia đình GPE
Mong được anh giúp đỡ
Thanks
Nhấp chuột vào đây để mở rộng...
Úi da! Nhìn kiểu bố trí mẫu in tôi không hiểu ra sao, 1 người có 3 trang, người 1 trang, người 6-10 trang... bạn làm sẵn 10 cái mẫu, rồi xem người nào bị nhiều trang gõ lệnh in bấy nhiêu trang hay là có 214 người thì lọc ra hết khoảng hơn 13.000 dòng?
Tui làm kiểu "làm biếng" này.
1/ Danh sách nằm ở cột N:P
2/ Muốn xem STT nào thì nhập STT đó vào ô [K2]
3/ [L2] hiển thị số trang của người đó có (Mỗi trang tối đa 24 dòng như mẫu)
4/ [M2] là số trang đang hiển thị tren màn hình, muốn xem trang khác thì thay số trang trong ô [M2].
5/ Bấm nút <GPE> sẽ hiện khung hội thoại, Bạn muốn làm gì thì làm tui hết biết "gồi".
6/ Tui chưa in thử!!!!! Híc!
------------
Chú ý: Có cột Q bị ẩn, xoá cột này là "tèo" luôn đó.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Em cảm ơn anh Ba Tê đầu xuân năm mới chúc anh và gia đình sức khỏe, an khang thịnh vượng và có thật nhiều công hiến để diễn đàn Giải pháp Excel ngày càng phát triển và giúp các thành viên ứng dụng tốt công cụ Excel vào công việc của mình. Một lầm nữa cảm ơn anh!
Anh Ba Tê đầu năm 2014 cho em làm phiền chút được không ạ em muốn khi in là nó hiện luôn trang 1 trang 2 như ở phần Header và Footer như em tạo trong file đính kèm được không ạ còn khi in số thứ tự như của anh thì lại không có được số trang anh ạ.
Ba Tê đã viết:
Úi da! Nhìn kiểu bố trí mẫu in tôi không hiểu ra sao, 1 người có 3 trang, người 1 trang, người 6-10 trang... bạn làm sẵn 10 cái mẫu, rồi xem người nào bị nhiều trang gõ lệnh in bấy nhiêu trang hay là có 214 người thì lọc ra hết khoảng hơn 13.000 dòng?
Tui làm kiểu "làm biếng" này.
1/ Danh sách nằm ở cột N:P
2/ Muốn xem STT nào thì nhập STT đó vào ô [K2]
3/ [L2] hiển thị số trang của người đó có (Mỗi trang tối đa 24 dòng như mẫu)
4/ [M2] là số trang đang hiển thị tren màn hình, muốn xem trang khác thì thay số trang trong ô [M2].
5/ Bấm nút <GPE> sẽ hiện khung hội thoại, Bạn muốn làm gì thì làm tui hết biết "gồi".
6/ Tui chưa in thử!!!!! Híc!
------------
Chú ý: Có cột Q bị ẩn, xoá cột này là "tèo" luôn đó.
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
Anh Ba Tê cho em hỏi chút là khi em ứng dụng Code của anh vào chương trình cho phù hợp với chương trình em đang cần thì ở phần: Hộ ông: hoặc hộ bà em sửa Code không được anh giúp em với
- Khi dữ liệu ở cột giới tính ở Sheet(DATA) là số 1 thì là Hộ ông: ..... tương ứng là và bà, còn số 2 là Hộ bà: .... tương ứng là và ông:
- Điều kiện ở phần và bà: ..., và ông nếu cột CQL2 không có dữ liệu thì là " .............."
Em sửa code như thế này thì nó chạy không ra như ý muốn anh giúp em với ạ
PHP: 
Public Sub LOC_BIEU1()
On Error Resume Next
Dim sArr(), dArr(1 To 3, 1 To 1), I As Long, Ong As String, NamSinh As String, CMND As String, NgayCap As String, NamSinh2 As String, CMND2 As String, Ong2 As String
Dim Ba As String, NgayCap2 As String, NoiCap As String, Diachi As String, Xa As String, Huyen As String, Tinh As String, DK As String, NoiCap2 As String, Ba2 As String
Dim K As Long, dArr2(1 To 1000, 1 To 10), N As Long, SoTrang As Double, Le As Boolean, Ba3 As String
With Sheets("DATA")
    sArr = .Range(.[A3], .[A65536].End(xlUp)).Resize(, 21).Value
End With
With Sheets("BIEU")
DK = .[K3].Value: Ong = .[Q1].Value: NamSinh = .[Q2].Value: CMND = .[Q3].Value: Ong2 = .[Q15].Value
NgayCap = .[Q4].Value: NgayCap2 = .[Q5].Value: NoiCap = .[Q6].Value: Ba = .[Q7].Value: NoiCap2 = .[Q13].Value
Diachi = .[Q8].Value: Xa = .[Q9].Value: Huyen = .[Q10].Value: NamSinh2 = .[Q11].Value: CMND2 = .[Q12].Value: Ba2 = .[Q14].Value: Ba3 = .[Q16].Value

For I = 1 To UBound(sArr, 1)
    If sArr(I, 1) = DK Then
        dArr(1, 1) = IIf(sArr(I, 21) = 1, Ong & sArr(I, 5), Ong2 & sArr(I, 5)) & NamSinh & _
            IIf(sArr(I, 2) <> "", sArr(I, 2), NamSinh2) & _
            IIf(sArr(I, 1) <> "", CMND & sArr(I, 1), CMND2) & NgayCap & _
            IIf(sArr(I, 3) <> "", Format(sArr(I, 3), "dd/mm/yyyy"), NgayCap2) & NoiCap & _
            IIf(sArr(I, 4) <> "", sArr(I, 4), NoiCap2)
        dArr(2, 1) = IIf(sArr(I, 21) = 1, Ba3, Ba) & _
        IIf(sArr(I, 6) <> "", sArr(I, 6), Ba2) & NamSinh & _
            IIf(sArr(I, 7) <> "", sArr(I, 7), NamSinh2) & _
            IIf(sArr(I, 8) <> "", CMND & sArr(I, 8), CMND2) & NgayCap & _
            IIf(sArr(I, 9) <> "", Format(sArr(I, 9), "dd/mm/yyyy"), NgayCap2) & NoiCap & _
            IIf(sArr(I, 10) <> "", sArr(I, 10), NoiCap2)
        dArr(3, 1) = Diachi & sArr(I, 11) & Xa & Huyen
        Exit For
    End If
Next I
For N = I To UBound(sArr, 1)
    If sArr(N, 1) = DK Then
        K = K + 1
            dArr2(K, 1) = sArr(N, 20): dArr2(K, 2) = sArr(N, 12): dArr2(K, 3) = sArr(N, 13)
            dArr2(K, 4) = sArr(N, 14): dArr2(K, 5) = "Không": dArr2(K, 6) = sArr(N, 18)
            dArr2(K, 7) = Right(sArr(N, 15), 10): dArr2(K, 8) = sArr(N, 19): dArr2(K, 9) = sArr(N, 16): dArr2(K, 10) = sArr(N, 17)
    End If
Next N
Application.EnableEvents = False
.[A3:A5].Value = dArr
.[A12:J35].Value = dArr2
SoTrang = K \ 24
If SoTrang > 0 Then
    If K Mod 24 > 0 Then SoTrang = SoTrang + 1
Else
    SoTrang = 1
End If
.[L2].Value = SoTrang
.[M2].Value = 1
Application.EnableEvents = True
End With
End Sub
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

Nguyễn Duy Tuân
Hàm BS COMBINLIST Liệt kê các giá trị tổ hợp, chỉnh hợp, chỉnh hợp không lặp | Add-in A-Tools v10 (4 người xem)
    • Yêu thích
    • Thích
Trả lời
22
Đọc
1K
nguyendang95
N
thanhsse
Tự động lấy dữ liệu từ các sheet khác đưa vào sheet tổng hợp khi chọn Ngày hoặc tháng hoặc năm (5 người xem)
Trả lời
2
Đọc
56
lamvankhoat1
L
J
Xử lý các file Excel bị nặng sau nhiều năm sử dụng (3 người xem)
Trả lời
13
Đọc
2K
huhumalu
H
H
Tổng hợp Công Nợ theo Công trình
Trả lời
24
Đọc
210
LOGANWover
L
T
Nhờ anh chị xem giúp file bị lỗi gì mà chạy rất chậm/lag - File tính tiền nhà trọ
Trả lời
8
Đọc
336
Thaik05
T
hongphuong1997
Nên sử dụng Chatgpt hay Copilot (2 người xem)
    • Yêu thích
Trả lời
12
Đọc
299
phuongnam366377
phuongnam366377
L
File Excel nặng chưa tìm được lý do ở đâu . Mong các bác hỗ trợ ! (1 người xem)
Trả lời
5
Đọc
114
PhanTuHuong
PhanTuHuong
U
VB tính tổng số cell trong 1 hàng có cùng màu với 1 cell so sánh ở cột khác (1 người xem)
Trả lời
5
Đọc
70
Hoàng Tuấn 868
H
T
VBA LẤY THÔNG TIN TRÊN TỜ KHAI NHẬP KHẨU
Trả lời
10
Đọc
617
binhminh1408
B
H
Giúp mình ghép nhiều file thành một file.
Trả lời
10
Đọc
425
hanhnguyen120221cuty
H
2
  • Question Question
Hỏi cách in phiếu điều tra PCGD-XMC từ file dữ liệu mẫu xuất ra từ hệ thống PCGD-XMC của Bộ GD (1 người xem)
    • Thích
Trả lời
18
Đọc
1K
Hoàng Tuấn 868
H
HeSanbi
  • Đã giải quyết
ZaloExcel v2.96: Gửi tin nhắn, hình ảnh, bảng, biểu đồ, tập tin, tạo nhóm, thu thập tin nhắn
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
60
Đọc
20K
HeSanbi
HeSanbi
D
XIN HỖ TRỢ VỀ FILE EXCEL TỔNG HỢP ĐIỂM THI ĐUA
Trả lời
0
Đọc
49
DươngH193
D
L
Xin file lịch báo giảng tự động (1 người xem)
Trả lời
2
Đọc
110
linedraw84
L
H
Xin File Theo dõi công nợ
Trả lời
0
Đọc
79
HangktGTN
H
N
Tạo file Excel dùng VBA để lấy và nối dữ liệu từ các files excel
Trả lời
39
Đọc
6K
hungnv_thct2026
H
S
Power BI. Một quá trình đòi hỏi sự kiên nhẫn.
Trả lời
4
Đọc
232
SteveNguyen1991
S
SA_DQ
  • Question Question
Bài tập VBA cho những người rỗi. . . đủ thứ!
    • Ngạc nhiên
    • Cười
    • Yêu thích
Trả lời
21
Đọc
795
Phuocam
Phuocam
H
  • Question Question
Dò tìm giá trị từ bảng khác theo cột
Trả lời
5
Đọc
132
ptm0412
ptm0412
L
Cách bật/tắt đèn led thứ 3 trên bàn phím cơ
Trả lời
1
Đọc
89
HUONGHCKT
H
Xem thêm…

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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom