Phần mềm ôn thi sát hạch chứng chỉ hành nghề xây dựng

Tiêu đề: {Hỏi}Macro lập tiến độ [In trang]

Tác giả: d.x.hieu2010 Thời gian: 15/2/2023 13:58
Tiêu đề: {Hỏi}Macro lập tiến độ
Nhờ ae tư vấn tạo macro ứng dụng để lập tiến độ (macro 1 và macro 2)
macro 1: biến hình 1 thành hình 2
macro 2: biến hình 2 về hình 1 như lúc đầu
Hình 1(chữ đỏ nằm ở ngày 11 và 21) và hình 2 (chữ đỏ nằm giữa ngày 11-39 và 21-49)
ghi chú: ở cột TT chạy từ 1,2 đến N, ở hình 2 đang liên kết tạm bằng thủ công

: Đăng nhập/Đăng ký mở rộng

: Đăng nhập/Đăng ký mở rộng

: Đăng nhập/Đăng ký mở rộng

Tiến độ 4.1 (diễn đàn).xlsm

492 KB, Lượt tải về: 1975

Tác giả: d.x.hieu2010 Thời gian: 21/2/2023 09:04
Có 1 a bên diễn đàn exell đã viết cod giúp mình (phai mình đã đính kèm ở trên), nhưng khi ấn lựa chon 2 xong các ô công thức mặc định (các ô bên phải ô chữ đỏ) đã bị xoá nên khi ấn lại lựa chọn 1 các ô đó sẽ bị mất công thức, nhờ ae giúp bổ sung đoạn macro (khi chọn 2 xong sẽ sửa công thức các ô bên phải ô chữ đỏ về như phai gốc ban đầu vì ngày bắt đầu và kết thúc mình sẽ căn chỉnh thường xuyên), mình xin gửi tiền cà phê, ăn sáng
Lưu ý: Lựa chọn 1 là: liên kết ô như hình 2 và Lựa chọn 2 là: trở về hình 1 (như lúc ban đầu)
Lưu ý: Lựa chọn 1 là: liên kết ô như hình 2 và Lựa chọn 2 là: trở về hình 1 (như lúc ban đầu)
Dòng cốt của a bên diễn đàn exel đây (phai có cod mình đã đính kèm ở trên):
Option Explicit
Sub merge()
Dim lr&, j&, ip&, cell As Range, celb As Range, bd, ngay
ip = InputBox(" Ban muon merge hay unmerge?" & vbLf & "1: merge" & vbLf & "2: unmerge")
lr = Cells(Rows.Count, "C").End(xlUp).Row
For Each cell In Range("CB10:CB" & lr)
If Not IsEmpty(cell) And IsNumeric(cell) Then
      bd = cell + IIf(cell Mod 2 = 0, 1, 0)
      ngay = (cell.Offset(, -1).Value - 1) / 2
      For Each celb In Range("CD8:FO8")
         If celb = bd Then
            With Cells(cell.Row, celb.Column)
                  Application.DisplayAlerts = False
                  .UnMerge
                  If ip = 1 Then
                     .Resize(1, ngay).merge
                     .Resize(1, ngay).HorizontalAlignment = xlCenter
                  End If
                  Application.DisplayAlerts = True
            End With
            Exit For
         End If
      Next
End If
Next
End Sub

Tiến độ 4.1 (diễn đàn).xlsm

492 KB, Lượt tải về: 1905

Tác giả: baocatsamac_nd Thời gian: 27/4/2023 15:08

d.x.hieu2010 gửi lúc 21/2/2023 09:04
Có 1 a bên diễn đàn exell đã viết cod giúp mình (phai mình đã đính kèm ở trên), nh ...

Mình gửi bạn nhé.

Tiến độ 4.1.xlsm

467.06 KB, Lượt tải về: 1633

Chào mừng ghé thăm Phần mềm ôn thi sát hạch chứng chỉ hành nghề xây dựng (https://xaydung360.vn/diendan/)