Kiểm tra sự tồn tại và chèn dòng tiêu đề cho tất cả các sheets trong 1 file excel

[kelacloi]

Chào anh/chị,

Em có 1 file excel chứa khoảng 250 sheets.
Trong mỗi sheets, dòng tiêu đề luôn là dòng 1 và là 1 trong các tên cột xuất hiện trong cột A (từ A2) của sheet 1 "FileChayCode", ví dụ ở đây tên các cột là một giá trị trong các giá trị A1, A2,..
Các cột không được sắp đúng thứ tự.
Nhu cầu của em:

Với mỗi sheet trong file "FileCanThay_TieuDe", tại dòng tiêu đề (dòng 1) kiểm tra xem tên cột đó đã xuất hiện trùng với một trong các giá trị từ dòng A2, đến dòng A30 của file "FileChayCode" chưa. Nếu trùng thì bỏ qua, còn nếu chưa có thì thêm các tên cột cho đủ 30 tên cột đó, không cần phải sắp lại thứ tự các cột.

Chỉ thay duy nhất dòng tiêu đề là dòng số 1, còn lại thì giữ nguyên dữ liệu,.

Ảnh đính kèm: Sheet 1 Ban dau là trước khi chạy code.
Ảnh: Ketqua là sau khi chạy code.

Em bổ sung thêm là số lượng cột trong các sheet ban đầu ở file "FileCanThay_TieuDe" có thể không bằng nhau, file 1 cột, file 4 cột,..


Cảm ơn anh/ chị.

Bài đã được tự động gộp: 18/7/22

 

[bebo021999]

1) Mở 2 file lên.
2) File chạy tiêu đề, Alt-F11 (mở VBA window), insert/module, copy code dưới vào:

Option Explicit
Sub test()
Dim lc&, i&, k&, rng, arr(), ws As Worksheet
With Workbooks("FileChayCode.xlsm").Worksheets("Sheet1")
    rng = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
End With
    For Each ws In Sheets
        k = 0
        lc = ws.Cells(1, Columns.Count).End(xlToLeft).Column
        ReDim arr(1 To UBound(rng) - lc + 1, 1 To 1)
        For i = 1 To UBound(rng)
            If WorksheetFunction.CountIf(ws.Range("A1", ws.Cells(1, lc)), rng(i, 1)) = 0 Then
                k = k + 1
                arr(k, 1) = rng(i, 1)
            End If
        Next
    ws.Cells(1, lc).Resize(1, k).Value = WorksheetFunction.Transpose(arr)
    Next
End Sub
[/code]
Nhấn F5 để chạy code

 

[kelacloi]

1) Mở 2 file lên.
2) File chạy tiêu đề, Alt-F11 (mở VBA window), insert/module, copy code dưới vào:

Option Explicit
Sub test()
Dim lc&, i&, k&, rng, arr(), ws As Worksheet
With Workbooks("FileChayCode.xlsm").Worksheets("Sheet1")
    rng = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
End With
    For Each ws In Sheets
        k = 0
        lc = ws.Cells(1, Columns.Count).End(xlToLeft).Column
        ReDim arr(1 To UBound(rng) - lc + 1, 1 To 1)
        For i = 1 To UBound(rng)
            If WorksheetFunction.CountIf(ws.Range("A1", ws.Cells(1, lc)), rng(i, 1)) = 0 Then
                k = k + 1
                arr(k, 1) = rng(i, 1)
            End If
        Next
    ws.Cells(1, lc).Resize(1, k).Value = WorksheetFunction.Transpose(arr)
    Next
End Sub
[/code]
Nhấn F5 để chạy code

Code đã chạy đúng ý rồi anh.
Cảm ơn anh.