Sai box: Nhờ tư vấn về macro

[4vuong4tron]

Có 1 a bên diễn đàn đã 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)
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

 

[Maika8008]

Bạn đã đăng sai box và bị khóa 1 lần rồi sao không rút kinh nghiệm nhỉ? Đăng trong box Lập trình với VBA ấy.
Sửa lại như sau (thêm 2 dòng đậm đậm, đỏ đỏ á):

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
                    Else
                        .Copy .Resize(1, ngay)
                    End If
                    Application.DisplayAlerts = True
                End With
                Exit For
            End If
        Next
    End If
Next
End Sub

 

[4vuong4tron]

Bạn đã đăng sai box và bị khóa 1 lần rồi sao không rút kinh nghiệm nhỉ? Đăng trong box Lập trình với VBA ấy.
Sửa lại như sau (thêm 2 dòng đậm đậm, đỏ đỏ á):

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
                    Else
                        .Copy .Resize(1, ngay)
                    End If
                    Application.DisplayAlerts = True
                End With
                Exit For
            End If
        Next
    End If
Next
End Sub

vẫn ko được ad ơi, ý em là copy ô công thức mẫu (ô vàng-bên phải ngày cuối) và dán sang ô xanh (cột ngày 1 đến ngày cuối) từ trên xuống dưới

 

[Maika8008]

vẫn ko được ad ơi

Đó là do ô có chữ đó là chữ chứ có phải công thức đâu. Nguyên ban đầu của nó là công thức, sao khi đem bài lên đây hỏi thì nó lại là chữ?

 

[4vuong4tron]

Đó là do ô có chữ đó là chữ chứ có phải công thức đâu. Nguyên ban đầu của nó là công thức, sao khi đem bài lên đây hỏi thì nó lại là chữ?

dạ, vậy nhờ a hướng dẫn em với ạ, phai chuẩn đây anh

 

[Maika8008]

dạ, vậy nhờ a hướng dẫn em với ạ, phai chuẩn đây anhView attachment 286756

Trong file này bạn đã thêm 2 dòng tôi chỉ và đã chạy tốt rồi mà. Còn phải sửa gì nữa?

 

[4vuong4tron]

Trong file này bạn đã thêm 2 dòng tôi chỉ và đã chạy tốt rồi mà. Còn phải sửa gì nữa?

dạ em cảm ơn anh, em muốn khi gõ 1 thì chữ màu đỏ sẽ hiện ra, còn khi gõ 2 chữ màu đỏ sẽ ẩn đi (các ô bôi xanh đó anh), nhờ a giúp em với

 

[Maika8008]

dạ em cảm ơn anh, em muốn khi gõ 1 thì chữ màu đỏ sẽ hiện ra, còn khi gõ 2 chữ màu đỏ sẽ ẩn đi (các ô bôi xanh đó anh), nhờ a giúp em với

Thêm 1 chút ở chỗ If ip = 1 then

                    If ip = 1 Then
                        .Resize(1, ngay).merge
                        .Resize(1, ngay).HorizontalAlignment = xlCenter
                        .Resize(1, ngay).Font.Color = vbRed
                    Else
                        .Copy .Resize(1, ngay)
                        .Resize(1, ngay).Font.Color = vbBlack
                    End If

 

[4vuong4tron]

Thêm 1 chút ở chỗ If ip = 1 then

                    If ip = 1 Then
                        .Resize(1, ngay).merge
                        .Resize(1, ngay).HorizontalAlignment = xlCenter
                        .Resize(1, ngay).Font.Color = vbRed
                    Else
                        .Copy .Resize(1, ngay)
                        .Resize(1, ngay).Font.Color = vbBlack
                    End If

dạ em muốn khi ấn 2 chữ màu đỏ sẽ không thấy đó anh (mặc định ô xanh khi chưa ấn 1 sẽ ẩn không thấy), ở trên đang để màu đen

 

[Maika8008]

dạ em muốn khi ấn 2 chữ màu đỏ sẽ không thấy đó anh (mặc định ô xanh khi chưa ấn 1 sẽ ẩn không thấy), ở trên đang để màu đen

Thay vbBlack bằng .Interior.Color !!! (có dấu chấm trước Interior)

 

[4vuong4tron]

Thay vbBlack bằng .Interior.Color !!! (có dấu chấm trước Interior)

nhờ a giúp em bổ sung trường hợp này với: khi chọn 1 nó mới hiện chữ đỏ, còn trường hợp khác thì toàn bộ ô màu xanh sẽ ko hiện chữ (để nếu e có thay đổi ngày bắt đầu chữ đỏ sẽ ko hiện), e cần vùng ô xanh từ cột cd(ngày 1) đến cột fo(ngày cuối) ẩn chữ

 

[Maika8008]

nhờ a giúp em với: khi chọn 1 nó mới hiện chữ đỏ, còn trường hợp khác thì toàn bộ ô màu xanh sẽ ko hiện chữ (để nếu e có thay đổi ngày bắt đầu chữ đỏ sẽ ko hiện), e cần vùng ô xanh từ cột cd(ngày 1) đến cột fo(ngày cuối) ẩn chữ

Vậy thì thay dòng .Resize(1, ngay).Font.Color = vbBlack ở bài #8 bằng dòng:

Range("CD" & cell.Row & ":FO" & cell.Row).Font.Color = .Interior.Color