Hồ sơ quản lý chất lượng công trình

quoctoanhud4 · 9/8/20

Cát Lượng đã viết:
Tác giả bổ sung thêm cái xuất nhật ký ra dạng cột để có thể in nhật ký kiểu trộn thư trên word thì hay quá!

Cái này mình cũng thấy hay này, chỉ cần xuất nhật ký ra file excell giống biên bản, thí nghiệm dạng cột để trộn thư thì tuỳ biến được nhiều

Cát Lượng · 11/8/20

Mutants Men đã viết:
Nhật ký chép tay đó bạn

Cái chép tay đó ở dạng dòng không trộn được thư, xoay lại chiều cho nó vào cột để trộn thư được, các dòng nội dung cho vào 1 ô trong cột (tương ứng với mỗi gạch đầu dòng trong ô đó là một dòng nội dung khi để ở dạng chép tay) Như vậy in ra Word chủ động được, thêm bớt và căn chỉnh, in sẽ đẹp, mẫu mã tùy chỉnh tốt mà vẫn đảm bảo nội dung yêu cầu.

chothadiem · 11/8/20

Cát Lượng đã viết:
Cái chép tay đó ở dạng dòng không trộn được thư, xoay lại chiều cho nó vào cột để trộn thư được, các dòng nội dung cho vào 1 ô trong cột (tương ứng với mỗi gạch đầu dòng trong ô đó là một dòng nội dung khi để ở dạng chép tay) Như vậy in ra Word chủ động được, thêm bớt và căn chỉnh, in sẽ đẹp, mẫu mã tùy chỉnh tốt mà vẫn đảm bảo nội dung yêu cầu.

Tui thấy ý này rất hay, in nhật ký không bị co nhẩy chỗ ký và tùy biến tốt

quanglenb · 11/8/20

Cát Lượng đã viết:
Cái chép tay đó ở dạng dòng không trộn được thư, xoay lại chiều cho nó vào cột để trộn thư được, các dòng nội dung cho vào 1 ô trong cột (tương ứng với mỗi gạch đầu dòng trong ô đó là một dòng nội dung khi để ở dạng chép tay) Như vậy in ra Word chủ động được, thêm bớt và căn chỉnh, in sẽ đẹp, mẫu mã tùy chỉnh tốt mà vẫn đảm bảo nội dung yêu cầu.

"." và hóng

Bài đã được tự động gộp: 11/8/20

Mutants Men đã viết:
thêm cột sẽ bị lỗi bạn nhé, ví dụ tại sheet BienbanCVXD bạn có thấy ô P2 là gí trị để dò không?
như bạn chèn 1 cột thì nó sẽ qua Q2 => xuất biên bản sẽ điền sai ô (điền vào đây P2) và sẽ ko dò được, còn cột U là để fix chiều cao dòng lúc điền thông tin công trình. sẽ nhảy sang cột V và sẽ ko fix được nữa., tạm thời bạn có thể chèn thêm 2 cột do còn dư cột N,O, chèn 2 cột rồi xóa 2 cột đó đi code có thể ko lỗi nữa

+ chèn vào sẽ lấy dữ liệu điền vào bị lệch bạn nhé, tui chưa thử nhưng xem ra có thể là vậy
+ để không lỗi bạn có thể vào đọc code tác giả share miễn phí đâu có giấu đâu bạn, và sửa lại cũng tốn cơm lắm, nhờ người khác thì hên xui người đó rảnh mà đọc code sửa cho bạn, thôi thì tự học mà sửa
+ để ko hiện thì 1 là bạn đạt đc trình độ như bên trên là đọc hiểu, còn không muốn điền TCNT thì xóa dữ liệu tại cột tiêu chuẩn tại sheet NhatTrinh đi, thì nó sẽ ko điền nữa (tui chưa thử nhưng thấy nội dung chương trình nó như vậy)

ý 1: điền thử công đúng rồi bạn
ý 2: điền nhanh hơn 1 công việc lặp đi lặp lại bạn có thể copy dòng rồi chèn dòng lại, chú ý không Ctrl +C rồi Ctrl +V (để ý dòng tô màu có chữ End)
còn muốn nhanh hơn thì chắc đợi Update từ tác giả thôi bạn.

bạn ko cần phải lấy nhiều mẫu vậy đâu, cứ chèn 1 biên bản lấy mẫu rồi thêm tất cả mẫu vào là được, có nút thêm đó.

Tui chỉ xem thôi chứ chưa dùng thử nên có gì sai sót mong tác giả bổ xung và bỏ quá cho.

Thân gửi đến các bạn!

Cảm ơn bạn!

QuangMinhtb · 11/8/20

Cát Lượng đã viết:
Cái chép tay đó ở dạng dòng không trộn được thư, xoay lại chiều cho nó vào cột để trộn thư được, các dòng nội dung cho vào 1 ô trong cột (tương ứng với mỗi gạch đầu dòng trong ô đó là một dòng nội dung khi để ở dạng chép tay) Như vậy in ra Word chủ động được, thêm bớt và căn chỉnh, in sẽ đẹp, mẫu mã tùy chỉnh tốt mà vẫn đảm bảo nội dung yêu cầu.

Mong tác giả sớm bổ sung.

dangky47h · 11/8/20

Cát Lượng đã viết:
Cái chép tay đó ở dạng dòng không trộn được thư, xoay lại chiều cho nó vào cột để trộn thư được, các dòng nội dung cho vào 1 ô trong cột (tương ứng với mỗi gạch đầu dòng trong ô đó là một dòng nội dung khi để ở dạng chép tay) Như vậy in ra Word chủ động được, thêm bớt và căn chỉnh, in sẽ đẹp, mẫu mã tùy chỉnh tốt mà vẫn đảm bảo nội dung yêu cầu.

Rất hợp lý

QuangMinhtb · 11/8/20

Mutants Men đã viết:
thêm cột sẽ bị lỗi bạn nhé, ví dụ tại sheet BienbanCVXD bạn có thấy ô P2 là gí trị để dò không?
như bạn chèn 1 cột thì nó sẽ qua Q2 => xuất biên bản sẽ điền sai ô (điền vào đây P2) và sẽ ko dò được, còn cột U là để fix chiều cao dòng lúc điền thông tin công trình. sẽ nhảy sang cột V và sẽ ko fix được nữa., tạm thời bạn có thể chèn thêm 2 cột do còn dư cột N,O, chèn 2 cột rồi xóa 2 cột đó đi code có thể ko lỗi nữa

+ chèn vào sẽ lấy dữ liệu điền vào bị lệch bạn nhé, tui chưa thử nhưng xem ra có thể là vậy
+ để không lỗi bạn có thể vào đọc code tác giả share miễn phí đâu có giấu đâu bạn, và sửa lại cũng tốn cơm lắm, nhờ người khác thì hên xui người đó rảnh mà đọc code sửa cho bạn, thôi thì tự học mà sửa
+ để ko hiện thì 1 là bạn đạt đc trình độ như bên trên là đọc hiểu, còn không muốn điền TCNT thì xóa dữ liệu tại cột tiêu chuẩn tại sheet NhatTrinh đi, thì nó sẽ ko điền nữa (tui chưa thử nhưng thấy nội dung chương trình nó như vậy)

ý 1: điền thử công đúng rồi bạn
ý 2: điền nhanh hơn 1 công việc lặp đi lặp lại bạn có thể copy dòng rồi chèn dòng lại, chú ý không Ctrl +C rồi Ctrl +V (để ý dòng tô màu có chữ End)
còn muốn nhanh hơn thì chắc đợi Update từ tác giả thôi bạn.

bạn ko cần phải lấy nhiều mẫu vậy đâu, cứ chèn 1 biên bản lấy mẫu rồi thêm tất cả mẫu vào là được, có nút thêm đó.

Tui chỉ xem thôi chứ chưa dùng thử nên có gì sai sót mong tác giả bổ xung và bỏ quá cho.

Thân gửi đến các bạn!

Nếu mà nhiều hạng mục thì mỗi hàng mục là một file đúng không Mutants Men ơi?

xuantocdotb · 11/8/20

quanglenb đã viết:
Anh/chị cho em hỏi giờ biên bản nghiệm thu công việc xây dựng thì mình điền thủ công vào trong List bien bản CV ạ?
Hay có quy luật hoặc cách nào điền nhanh hơn ạ?

Vậy mỗi lần sửa lại bên nhật trình thì lại phải sửa giờ lại từ đầu bên List dúng không admin?

Mutants Men · 14/8/20

Cát Lượng đã viết:
Cái chép tay đó ở dạng dòng không trộn được thư, xoay lại chiều cho nó vào cột để trộn thư được, các dòng nội dung cho vào 1 ô trong cột (tương ứng với mỗi gạch đầu dòng trong ô đó là một dòng nội dung khi để ở dạng chép tay) Như vậy in ra Word chủ động được, thêm bớt và căn chỉnh, in sẽ đẹp, mẫu mã tùy chỉnh tốt mà vẫn đảm bảo nội dung yêu cầu.

xin cái mẫu bạn muốn xuất ra như thế nào đi, nào tác giả cho phép thì tui sửa lại cho :v, chứ của ngta mà lao vô sửa như của mình thì chết, cướp công ăn việc làm của tác giả.
mục này thì có sheet InNKTC không đáp ứng được sao?

QuangMinhtb đã viết:
Nếu mà nhiều hạng mục thì mỗi hàng mục là một file đúng không Mutants Men ơi?

Đúng rồi bạn! theo tôi thấy thì khi bạn chọn mã công việc và chọn "Thi công" là bắt đầu 1 công việc mới (dòng màu tím), "Nghiệm thu" là kết thúc 1 công việc (dòng màu đen), những biên bản kèm theo ở giữa 2 dòng màu tím và đen đó gom chung lại là thành 1 bộ nghiệm thu 1 hạng mục công việc theo giai đoạn. ví dụ như thi công bê tông mố thì thi công bệ mố rồi thân mố, tường cánh, vậy là cần 3 biên bản nghiệm thu công việc

xuantocdotb đã viết:
Vậy mỗi lần sửa lại bên nhật trình thì lại phải sửa giờ lại từ đầu bên List dúng không admin?

ý bạn là sửa ở đâu, theo tôi thấy là giờ sẽ tự chỉnh cho bạn. còn bạn muốn chỉnh tay thì chỉnh bên sheet ListBBCV

PacificPR · 14/8/20

Mutants Men đã viết:
xin cái mẫu bạn muốn xuất ra như thế nào đi, nào tác giả cho phép thì tui sửa lại cho :v, chứ của ngta mà lao vô sửa như của mình thì chết, cướp công ăn việc làm của tác giả.
mục này thì có sheet InNKTC không đáp ứng được sao?

Đúng rồi bạn! theo tôi thấy thì khi bạn chọn mã công việc và chọn "Thi công" là bắt đầu 1 công việc mới (dòng màu tím), "Nghiệm thu" là kết thúc 1 công việc (dòng màu đen), những biên bản kèm theo ở giữa 2 dòng màu tím và đen đó gom chung lại là thành 1 bộ nghiệm thu 1 hạng mục công việc theo giai đoạn. ví dụ như thi công bê tông mố thì thi công bệ mố rồi thân mố, tường cánh, vậy là cần 3 biên bản nghiệm thu công việc
ý bạn là sửa ở đâu, theo tôi thấy là giờ sẽ tự chỉnh cho bạn. còn bạn muốn chỉnh tay thì chỉnh bên sheet ListBBCV

Bạn rảnh thì sửa cho nhà họ đi. Dạo này mình bận quá không nghịch ngợm được gì. Mình đã nhận được File Bạn gửi rồi. Có gì mình sẽ phản hồi lại sớm nhé. Cám ơn Bạn nhiều

xuantocdotb · 14/8/20

Mutants Men đã viết:
xin cái mẫu bạn muốn xuất ra như thế nào đi, nào tác giả cho phép thì tui sửa lại cho :v, chứ của ngta mà lao vô sửa như của mình thì chết, cướp công ăn việc làm của tác giả.
mục này thì có sheet InNKTC không đáp ứng được sao?

Đúng rồi bạn! theo tôi thấy thì khi bạn chọn mã công việc và chọn "Thi công" là bắt đầu 1 công việc mới (dòng màu tím), "Nghiệm thu" là kết thúc 1 công việc (dòng màu đen), những biên bản kèm theo ở giữa 2 dòng màu tím và đen đó gom chung lại là thành 1 bộ nghiệm thu 1 hạng mục công việc theo giai đoạn. ví dụ như thi công bê tông mố thì thi công bệ mố rồi thân mố, tường cánh, vậy là cần 3 biên bản nghiệm thu công việc
ý bạn là sửa ở đâu, theo tôi thấy là giờ sẽ tự chỉnh cho bạn. còn bạn muốn chỉnh tay thì chỉnh bên sheet ListBBCV

Ý mình là ở sheet (Nhattrinh) sẽ điền ngày thi công, ngày nghiệm thu và sau đó xuất sang List thì mới điền được giờ vào.
Giờ sẽ tự chỉnh thì vào đâu để chỉnh vậy bạn? mình chưa biết mục này.
Mong bạn giúp xin cảm ơn!

Cát Lượng · 14/8/20

PacificPR đã viết:
Bạn rảnh thì sửa cho nhà họ đi. Dạo này mình bận quá không nghịch ngợm được gì. Mình đã nhận được File Bạn gửi rồi. Có gì mình sẽ phản hồi lại sớm nhé. Cám ơn Bạn nhiều

Đó! Mutants Men, tác giả PacificPR đồng ý rồi, bạn sửa để cho ra sheet (Nhatky_dangcot) dùng để trộn thư đi.

Mutants Men · 14/8/20

PacificPR đã viết:
Bạn rảnh thì sửa cho nhà họ đi. Dạo này mình bận quá không nghịch ngợm được gì. Mình đã nhận được File Bạn gửi rồi. Có gì mình sẽ phản hồi lại sớm nhé. Cám ơn Bạn nhiều

Để xem đã, hiện tại đã bỏ được kha khác biến trong code để người dùng có thể thêm biên bản của mình vào. thấy hình như thiếu vụ đóng cọc, cừ tràm, vải địa này kia he.

xuantocdotb đã viết:
Ý mình là ở sheet (Nhattrinh) sẽ điền ngày thi công, ngày nghiệm thu và sau đó xuất sang List thì mới điền được giờ vào.
Giờ sẽ tự chỉnh thì vào đâu để chỉnh vậy bạn? mình chưa biết mục này.
Mong bạn giúp xin cảm ơn!

bạn biết chỉnh thì vào sheet Config mà chỉnh, còn tui thì thua, thấy hình như là 1 ngày đc 8 biên bản ở 8 khung giờ đó đó, còn hơn thì bị trống giờ.

Cát Lượng · 14/8/20

Mutants Men đã viết:
xin cái mẫu bạn muốn xuất ra như thế nào đi, nào tác giả cho phép thì tui sửa lại cho :v, chứ của ngta mà lao vô sửa như của mình thì chết, cướp công ăn việc làm của tác giả.
mục này thì có sheet InNKTC không đáp ứng được sao?

Đúng rồi bạn! theo tôi thấy thì khi bạn chọn mã công việc và chọn "Thi công" là bắt đầu 1 công việc mới (dòng màu tím), "Nghiệm thu" là kết thúc 1 công việc (dòng màu đen), những biên bản kèm theo ở giữa 2 dòng màu tím và đen đó gom chung lại là thành 1 bộ nghiệm thu 1 hạng mục công việc theo giai đoạn. ví dụ như thi công bê tông mố thì thi công bệ mố rồi thân mố, tường cánh, vậy là cần 3 biên bản nghiệm thu công việc
ý bạn là sửa ở đâu, theo tôi thấy là giờ sẽ tự chỉnh cho bạn. còn bạn muốn chỉnh tay thì chỉnh bên sheet ListBBCV

Nếu mỗi lần cần phải chỉnh sửa vậy lại phiền bạn, có lẽ sẽ hơi bất cập.
Để các anh/em có thể chủ động được khi in nhật ký và thêm mắm thêm muối thì thay bằng bạn giúp sửa mẫu nhật ký đã sẵn có xin được nhờ bạn giúp xuất nội dung nhật ký ra thêm một sheet (Nhatky_dangcot) để trộn thư khi in.

xuantocdotb · 14/8/20

Mutants Men đã viết:
Để xem đã, hiện tại đã bỏ được kha khác biến trong code để người dùng có thể thêm biên bản của mình vào. thấy hình như thiếu vụ đóng cọc, cừ tràm, vải địa này kia he.
bạn biết chỉnh thì vào sheet Config mà chỉnh, còn tui thì thua, thấy hình như là 1 ngày đc 8 biên bản ở 8 khung giờ đó đó, còn hơn thì bị trống giờ.

Cám ơn bạn!

Mutants Men · 14/8/20

Cát Lượng đã viết:
Nếu mỗi lần cần phải chỉnh sửa vậy lại phiền bạn, có lẽ sẽ hơi bất cập.
Để các anh/em có thể chủ động được khi in nhật ký và thêm mắm thêm muối thì thay bằng bạn giúp sửa mẫu nhật ký đã sẵn có xin được nhờ bạn giúp xuất nội dung nhật ký ra thêm một sheet (Nhatky_dangcot) để trộn thư khi in.

ý bạn muốn như hình đúng không?
Nội dung code

Mã:

Sub TronNhatKy()
Dim nArr As Variant, kArr As Variant, i As Long, k As Long, Er As Long
Dim NoidungCV As String, Thoitiet As String, NL As String, ThietbiTC As String
    NoidungCV = "N" & ChrW$(7897) & "i c" & ChrW$(244) & "ng vi" & ChrW$(7879) & "c thi c" & ChrW$(244) & "ng trong ng" & ChrW$(224) & "y:"
    Thoitiet = "Th" & ChrW$(7901) & "i ti" & ChrW$(7871) & "t:"
    NL = "Nh" & ChrW$(226) & "n l" & ChrW$(7921) & "c: "
    ThietbiTC = "Thi" & ChrW$(7871) & "t b" & ChrW$(7883) & " thi c" & ChrW$(244) & "ng: "
   
   
    With Sheets("GhiNhatKy") 'lay du lieu NK chi tiet
        nArr = .Range("A6:B" & .Range("B65535").End(3).Row).value
    End With
    ReDim kArr(1 To UBound(nArr), 1 To 6)
    k = 1
    kArr(k, 1) = "Ngày"
    kArr(k, 2) = Thoitiet
    kArr(k, 3) = NL
    kArr(k, 4) = ThietbiTC
    kArr(k, 5) = NoidungCV

   
    For i = 1 To UBound(nArr)
        If nArr(i, 1) <> Empty Then
            k = k + 1
            kArr(k, 1) = nArr(i, 1)
            '
            kArr(k, 2) = Replace(nArr(i, 2), Thoitiet, "")
           
        Else
            If Left(nArr(i, 2), Len(NL)) = NL Then
                kArr(k, 3) = Replace(nArr(i, 2), NL, "")
            ElseIf Left(nArr(i, 2), Len(ThietbiTC)) = ThietbiTC Then
                kArr(k, 4) = Replace(nArr(i, 2), ThietbiTC, "")
            ElseIf Left(nArr(i, 2), Len(NoidungCV)) = NoidungCV Then
            Else
                If kArr(k, 5) = Empty Then
                    kArr(k, 5) = nArr(i, 2)
                Else
                    If nArr(i, 2) <> Empty Then kArr(k, 5) = kArr(k, 5) & ChrW(10) & nArr(i, 2)
                End If
            End If
        End If
    Next i
    If k Then
    With Sheets("Nhatky_dangcot")
        Er = .Range("A65535").End(3).Row + 1
        .Range("A1:E" & Er).ClearContents
        .Range("A1:E" & Er).Borders.LineStyle = xlNone
        With .Range("A1").Resize(k, 5)
            .value = kArr
            .WrapText = True
            .HorizontalAlignment = xlJustify
        End With
    End With
    End If
End Sub

Nhấn Alt+ F11 lên để mở bảng soạn code
Tìm đến module Ribbon\ Sub Xuatdulieunhatky(control As IRibbonControl)
thay thế nguyên Sub đó luôn như này

Mã:

Sub Xuatdulieunhatky(control As IRibbonControl)
    On Error Resume Next
    Application.ScreenUpdating = False
    Call DMNhatky
    Call Phantichnhatky
    Call Ghinhatky
    Call TronNhatKy
    Application.ScreenUpdating = True
    MsgboxUni VNI("Ñaơ xuaát xong döơ lieäu nhaät kyù thi coâng"), vbInformation, VNI("Thoâng baùo")
End Sub

hoặc
thêm Call TronNhatKy ngay bên dưới Call Ghinhatky rồi ra ngoài trang tính nhấn Xuất Nhật Ký (nhớ tạo Sheet Nhatky_dangcot đã nha)

quoctoanhud4 · 15/8/20

Mutants Men đã viết:

ý bạn muốn như hình đúng không?
Nội dung code

Mã:

Sub TronNhatKy()
Dim nArr As Variant, kArr As Variant, i As Long, k As Long, Er As Long
Dim NoidungCV As String, Thoitiet As String, NL As String, ThietbiTC As String
    NoidungCV = "N" & ChrW$(7897) & "i c" & ChrW$(244) & "ng vi" & ChrW$(7879) & "c thi c" & ChrW$(244) & "ng trong ng" & ChrW$(224) & "y:"
    Thoitiet = "Th" & ChrW$(7901) & "i ti" & ChrW$(7871) & "t:"
    NL = "Nh" & ChrW$(226) & "n l" & ChrW$(7921) & "c: "
    ThietbiTC = "Thi" & ChrW$(7871) & "t b" & ChrW$(7883) & " thi c" & ChrW$(244) & "ng: "
 
 
    With Sheets("GhiNhatKy") 'lay du lieu NK chi tiet
        nArr = .Range("A6:B" & .Range("B65535").End(3).Row).value
    End With
    ReDim kArr(1 To UBound(nArr), 1 To 6)
    k = 1
    kArr(k, 1) = "Ngày"
    kArr(k, 2) = Thoitiet
    kArr(k, 3) = NL
    kArr(k, 4) = ThietbiTC
    kArr(k, 5) = NoidungCV

 
    For i = 1 To UBound(nArr)
        If nArr(i, 1) <> Empty Then
            k = k + 1
            kArr(k, 1) = nArr(i, 1)
            '
            kArr(k, 2) = Replace(nArr(i, 2), Thoitiet, "")
         
        Else
            If Left(nArr(i, 2), Len(NL)) = NL Then
                kArr(k, 3) = Replace(nArr(i, 2), NL, "")
            ElseIf Left(nArr(i, 2), Len(ThietbiTC)) = ThietbiTC Then
                kArr(k, 4) = Replace(nArr(i, 2), ThietbiTC, "")
            ElseIf Left(nArr(i, 2), Len(NoidungCV)) = NoidungCV Then
            Else
                If kArr(k, 5) = Empty Then
                    kArr(k, 5) = nArr(i, 2)
                Else
                    If nArr(i, 2) <> Empty Then kArr(k, 5) = kArr(k, 5) & ChrW(10) & nArr(i, 2)
                End If
            End If
        End If
    Next i
    If k Then
    With Sheets("Nhatky_dangcot")
        Er = .Range("A65535").End(3).Row + 1
        .Range("A1:E" & Er).ClearContents
        .Range("A1:E" & Er).Borders.LineStyle = xlNone
        With .Range("A1").Resize(k, 5)
            .value = kArr
            .WrapText = True
            .HorizontalAlignment = xlJustify
        End With
    End With
    End If
End Sub

Nhấn Alt+ F11 lên để mở bảng soạn code
Tìm đến module Ribbon\ Sub Xuatdulieunhatky(control As IRibbonControl)
thay thế nguyên Sub đó luôn như này

Mã:

Sub Xuatdulieunhatky(control As IRibbonControl)
    On Error Resume Next
    Application.ScreenUpdating = False
    Call DMNhatky
    Call Phantichnhatky
    Call Ghinhatky
    Call TronNhatKy
    Application.ScreenUpdating = True
    MsgboxUni VNI("Ñaơ xuaát xong döơ lieäu nhaät kyù thi coâng"), vbInformation, VNI("Thoâng baùo")
End Sub

hoặc
thêm Call TronNhatKy ngay bên dưới Call Ghinhatky rồi ra ngoài trang tính nhấn Xuất Nhật Ký (nhớ tạo Sheet Nhatky_dangcot đã nha)

Đã làm thành công theo chỉ dẫn của bạn, giờ lại thêm một phần tuỳ chọn nữa để xuất nhật ký, file hiện vẫn còn vài hạn chế như: phần số đếm BB (không copy công trình khác vào được mà phải đánh mã CV mới đếm được), tuỳ chọn mã CV chưa linh hoạt, chưa xuất ra ngày mưa ... nhưng nếu có người như bạn thì sẽ được hoàn thiện hơn. Cám ơn bạn nhiều.

chothadiem · 15/8/20

Mutants Men đã viết:

ý bạn muốn như hình đúng không?
Nội dung code

Mã:

Sub TronNhatKy()
Dim nArr As Variant, kArr As Variant, i As Long, k As Long, Er As Long
Dim NoidungCV As String, Thoitiet As String, NL As String, ThietbiTC As String
    NoidungCV = "N" & ChrW$(7897) & "i c" & ChrW$(244) & "ng vi" & ChrW$(7879) & "c thi c" & ChrW$(244) & "ng trong ng" & ChrW$(224) & "y:"
    Thoitiet = "Th" & ChrW$(7901) & "i ti" & ChrW$(7871) & "t:"
    NL = "Nh" & ChrW$(226) & "n l" & ChrW$(7921) & "c: "
    ThietbiTC = "Thi" & ChrW$(7871) & "t b" & ChrW$(7883) & " thi c" & ChrW$(244) & "ng: "
  
  
    With Sheets("GhiNhatKy") 'lay du lieu NK chi tiet
        nArr = .Range("A6:B" & .Range("B65535").End(3).Row).value
    End With
    ReDim kArr(1 To UBound(nArr), 1 To 6)
    k = 1
    kArr(k, 1) = "Ngày"
    kArr(k, 2) = Thoitiet
    kArr(k, 3) = NL
    kArr(k, 4) = ThietbiTC
    kArr(k, 5) = NoidungCV

  
    For i = 1 To UBound(nArr)
        If nArr(i, 1) <> Empty Then
            k = k + 1
            kArr(k, 1) = nArr(i, 1)
            '
            kArr(k, 2) = Replace(nArr(i, 2), Thoitiet, "")
          
        Else
            If Left(nArr(i, 2), Len(NL)) = NL Then
                kArr(k, 3) = Replace(nArr(i, 2), NL, "")
            ElseIf Left(nArr(i, 2), Len(ThietbiTC)) = ThietbiTC Then
                kArr(k, 4) = Replace(nArr(i, 2), ThietbiTC, "")
            ElseIf Left(nArr(i, 2), Len(NoidungCV)) = NoidungCV Then
            Else
                If kArr(k, 5) = Empty Then
                    kArr(k, 5) = nArr(i, 2)
                Else
                    If nArr(i, 2) <> Empty Then kArr(k, 5) = kArr(k, 5) & ChrW(10) & nArr(i, 2)
                End If
            End If
        End If
    Next i
    If k Then
    With Sheets("Nhatky_dangcot")
        Er = .Range("A65535").End(3).Row + 1
        .Range("A1:E" & Er).ClearContents
        .Range("A1:E" & Er).Borders.LineStyle = xlNone
        With .Range("A1").Resize(k, 5)
            .value = kArr
            .WrapText = True
            .HorizontalAlignment = xlJustify
        End With
    End With
    End If
End Sub

Nhấn Alt+ F11 lên để mở bảng soạn code
Tìm đến module Ribbon\ Sub Xuatdulieunhatky(control As IRibbonControl)
thay thế nguyên Sub đó luôn như này

Mã:

Sub Xuatdulieunhatky(control As IRibbonControl)
    On Error Resume Next
    Application.ScreenUpdating = False
    Call DMNhatky
    Call Phantichnhatky
    Call Ghinhatky
    Call TronNhatKy
    Application.ScreenUpdating = True
    MsgboxUni VNI("Ñaơ xuaát xong döơ lieäu nhaät kyù thi coâng"), vbInformation, VNI("Thoâng baùo")
End Sub

hoặc
thêm Call TronNhatKy ngay bên dưới Call Ghinhatky rồi ra ngoài trang tính nhấn Xuất Nhật Ký (nhớ tạo Sheet Nhatky_dangcot đã nha)

Xin phép PacificPR được nhờ Mutants Men và các anh/chị trên GPE:
Theo Điều 10 Thông tư 26/2016/TT-BXD thì nhật ký thi công cần có diễn biến điều kiện thi công (nhiệt độ, thời tiết và các thông tin liên quan)
Xin được PacificPR được nhờ Mutants Men và các anh/chị trên GPE bổ sung thêm nhiệt độ đã có ở cột C trong Sheet(Tb_Thoitiet) để cho vào nhật ký sẵn có và xuất ra Sheet(Nhatky_dangcot) gồm cả cột nhiệt độ được không ạ?

Cát Lượng · 15/8/20

Mutants Men đã viết:

ý bạn muốn như hình đúng không?
Nội dung code

Mã:

Sub TronNhatKy()
Dim nArr As Variant, kArr As Variant, i As Long, k As Long, Er As Long
Dim NoidungCV As String, Thoitiet As String, NL As String, ThietbiTC As String
    NoidungCV = "N" & ChrW$(7897) & "i c" & ChrW$(244) & "ng vi" & ChrW$(7879) & "c thi c" & ChrW$(244) & "ng trong ng" & ChrW$(224) & "y:"
    Thoitiet = "Th" & ChrW$(7901) & "i ti" & ChrW$(7871) & "t:"
    NL = "Nh" & ChrW$(226) & "n l" & ChrW$(7921) & "c: "
    ThietbiTC = "Thi" & ChrW$(7871) & "t b" & ChrW$(7883) & " thi c" & ChrW$(244) & "ng: "
 
 
    With Sheets("GhiNhatKy") 'lay du lieu NK chi tiet
        nArr = .Range("A6:B" & .Range("B65535").End(3).Row).value
    End With
    ReDim kArr(1 To UBound(nArr), 1 To 6)
    k = 1
    kArr(k, 1) = "Ngày"
    kArr(k, 2) = Thoitiet
    kArr(k, 3) = NL
    kArr(k, 4) = ThietbiTC
    kArr(k, 5) = NoidungCV

 
    For i = 1 To UBound(nArr)
        If nArr(i, 1) <> Empty Then
            k = k + 1
            kArr(k, 1) = nArr(i, 1)
            '
            kArr(k, 2) = Replace(nArr(i, 2), Thoitiet, "")
         
        Else
            If Left(nArr(i, 2), Len(NL)) = NL Then
                kArr(k, 3) = Replace(nArr(i, 2), NL, "")
            ElseIf Left(nArr(i, 2), Len(ThietbiTC)) = ThietbiTC Then
                kArr(k, 4) = Replace(nArr(i, 2), ThietbiTC, "")
            ElseIf Left(nArr(i, 2), Len(NoidungCV)) = NoidungCV Then
            Else
                If kArr(k, 5) = Empty Then
                    kArr(k, 5) = nArr(i, 2)
                Else
                    If nArr(i, 2) <> Empty Then kArr(k, 5) = kArr(k, 5) & ChrW(10) & nArr(i, 2)
                End If
            End If
        End If
    Next i
    If k Then
    With Sheets("Nhatky_dangcot")
        Er = .Range("A65535").End(3).Row + 1
        .Range("A1:E" & Er).ClearContents
        .Range("A1:E" & Er).Borders.LineStyle = xlNone
        With .Range("A1").Resize(k, 5)
            .value = kArr
            .WrapText = True
            .HorizontalAlignment = xlJustify
        End With
    End With
    End If
End Sub

Nhấn Alt+ F11 lên để mở bảng soạn code
Tìm đến module Ribbon\ Sub Xuatdulieunhatky(control As IRibbonControl)
thay thế nguyên Sub đó luôn như này

Mã:

Sub Xuatdulieunhatky(control As IRibbonControl)
    On Error Resume Next
    Application.ScreenUpdating = False
    Call DMNhatky
    Call Phantichnhatky
    Call Ghinhatky
    Call TronNhatKy
    Application.ScreenUpdating = True
    MsgboxUni VNI("Ñaơ xuaát xong döơ lieäu nhaät kyù thi coâng"), vbInformation, VNI("Thoâng baùo")
End Sub

hoặc
thêm Call TronNhatKy ngay bên dưới Call Ghinhatky rồi ra ngoài trang tính nhấn Xuất Nhật Ký (nhớ tạo Sheet Nhatky_dangcot đã nha)

Cảm ơn bạn!
Bạn cho mình hỏi: Làmcách nào để xừa xuất ra được Sheet (Nhatky_dangcot) mà vừa vẫn có thể giữ lại Sheet(InNKTC)
Mình làm như bạn hướng dẫn thì xuất ra được Sheet (Nhatky_dangcot) nhưng khi Spin dữ liệu trên Sheet(InNKTC) lại không chạy.
Ý mình muốn vừa có thể sử dụng Sheet(InNKTC) như ban đầu và xuất được dữ liệu Sheet (Nhatky_dangcot)
Chứ không chỉ xuất được Sheet (Nhatky_dangcot) mà Sheet(InNKTC) lại không sử dụng được nữa!

quanglenb · 15/8/20

xuantocdotb đã viết:
Ý mình là ở sheet (Nhattrinh) sẽ điền ngày thi công, ngày nghiệm thu và sau đó xuất sang List thì mới điền được giờ vào.
Giờ sẽ tự chỉnh thì vào đâu để chỉnh vậy bạn? mình chưa biết mục này.
Mong bạn giúp xin cảm ơn!

Vào đâu để "theo tôi thấy là giờ sẽ tự chỉnh cho bạn"?
Em tìm mà không thấy đâu ?
Mong anh chỉ giúp!

Hồ sơ quản lý chất lượng công trình

Thành viên chính thức

Thành viên tiêu biểu

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

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

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

Thành viên thường trực

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

Thành viên chính thức

Thành viên thường trực

Thành viên mới

Thành viên chính thức

Thành viên tiêu biểu

Thành viên thường trực

Thành viên tiêu biểu

Thành viên chính thức

Thành viên thường trực

File đính kèm

Thành viên chính thức

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

Thành viên tiêu biểu

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

Facebook

Group