{Hỏi về macro làm tiến độ} (1 người xem)

[4vuong4tron]

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 đến N

 

[BuiQuangThuan]

Chưa hiểu ý đồ lắm.

 

[4vuong4tron]

Chưa hiểu ý đồ

Mình muốn biến Hình 1 thành Hình 2 và ngược lại. Hình 1 (chữ nằm ở đầu ngày bắt đầu ngày 11 và ngày 21) còn Hình 2 (chữ nằm ở giữa ngày bắt đầu và ngày kết thúc ngày 11-39 và 21-49).
Hình 2 mình đang sử dụng thủ công (liên kết các cột lại để cho chữ nằm giữa)
Có cách nào chọn tự động chữ đỏ ở số TT 1, chọn ô từ ngày 11-39 và ấn liên kết, tiếp theo chọn chữ đỏ ở số TT2, chọn ô từ ngày 21-49 và ấn liên kết

 

[bebo021999]

Mình tích hợp 2 macro vào 1.
Khi run thì sẽ cho cho chọn 1 hay 2
Nếu chọn 1, sẽ merge tất cả các ô có liên quan
Nếu chọn 2, bỏ merge hết

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

 

[4vuong4tron]

Mình tích hợp 2 macro vào 1.
Khi run thì sẽ cho cho chọn 1 hay 2
Nếu chọn 1, sẽ merge tất cả các ô có liên quan
Nếu chọn 2, bỏ merge hết

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

Nhờ anh sửa giúp em cod với:
1. Chữ màu đỏ lúc đầu là các ô chứa công thức nên khi mình chạy macro (2) xong và sửa lại ngày bắt đầu và ngày kết thúc của các công tác 1 và 2 thì nó không chạy nữa
2. Em muốn mặc định ban đầu chữ màu đỏ "ẩn" và chỉ khi chạy macro(1) xong nó mới hiện, còn khi chạy macro(2) nó sẽ lại "ẩn" tiếp

 

[4vuong4tron]

Nhờ anh sửa giúp em cod với:
1. Chữ màu đỏ lúc đầu là các ô chứa công thức nên khi mình chạy macro (2) xong và sửa lại ngày bắt đầu và ngày kết thúc của các công tác 1 và 2 thì nó không chạy nữa
2. Em muốn mặc định ban đầu chữ màu đỏ "ẩn" và chỉ khi chạy macro(1) xong nó mới hiện, còn khi chạy macro(2) nó sẽ lại "ẩn" tiếp

Nhờ các ae tư vấn giúp, mình xin gửi ít phí

 

[bebo021999]

Ah, giờ mới thấy yêu cầu mới này.
Làm lại nhé.
Cách dùng: Thay đổi giá trị ngày bắt đầu và kết thúc tại cột CB và CC, sự kiện "change" sẽ kích hoạt.
Code đặt trong worksheet module nhé.
Với dòng liên quan:
1- Bỏ merge tất cả từ cột CD:FO, phục hồi nguyên trạng format (Mình chọn phương án copy dòng 9 xuống vì sẽ copy cả border và format luôn)
2- Merge các cột tương ứng với ngày bắt đầu - kết thúc
3- Các công thức tại dòng merge không nhất thiết phải điền vào ô.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr&, r&, bd&, kt&, cell As Range
lr = Cells(Rows.Count, "CB").End(xlUp).Row
If Intersect(Target, Range("CB10:CC" & lr)) Is Nothing Then Exit Sub
r = Target.Row
Range("CD9:FO9").Copy Range(Cells(r, "CD"), Cells(r, "FO"))
bd = Cells(r, "CB") + IIf(Cells(r, "CB") Mod 2 = 0, 1, 0)
kt = Cells(r, "CC") + IIf(Cells(r, "CC") Mod 2 = 0, -1, 0)
For Each cell In Range(Cells(r, "CD"), Cells(r, "FO"))
    If Cells(8, cell.Column).Value = bd Then
        With cell.Resize(1, 1 + (kt - bd) / 2)
            .merge
            .HorizontalAlignment = xlCenter
            .Value = Range("F" & r).Value & " " & Range("F6").Value & ", " & Range("Q" & r).Value & " " & Range("Q6").Value
        End With
        Exit For
    End If
Next
End Sub

 

[Maika8008]

Ah, giờ mới thấy yêu cầu mới này.
Làm lại nhé.
Cách dùng: Thay đổi giá trị ngày bắt đầu và kết thúc tại cột CB và CC, sự kiện "change" sẽ kích hoạt.
Code đặt trong worksheet module nhé.
Với dòng liên quan:
1- Bỏ merge tất cả từ cột CD:FO, phục hồi nguyên trạng format (Mình chọn phương án copy dòng 9 xuống vì sẽ copy cả border và format luôn)
2- Merge các cột tương ứng với ngày bắt đầu - kết thúc
3- Các công thức tại dòng merge không nhất thiết phải điền vào ô.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr&, r&, bd&, kt&, cell As Range
lr = Cells(Rows.Count, "CB").End(xlUp).Row
If Intersect(Target, Range("CB10:CC" & lr)) Is Nothing Then Exit Sub
r = Target.Row
Range("CD9:FO9").Copy Range(Cells(r, "CD"), Cells(r, "FO"))
bd = Cells(r, "CB") + IIf(Cells(r, "CB") Mod 2 = 0, 1, 0)
kt = Cells(r, "CC") + IIf(Cells(r, "CC") Mod 2 = 0, -1, 0)
For Each cell In Range(Cells(r, "CD"), Cells(r, "FO"))
    If Cells(8, cell.Column).Value = bd Then
        With cell.Resize(1, 1 + (kt - bd) / 2)
            .merge
            .HorizontalAlignment = xlCenter
            .Value = Range("F" & r).Value & " " & Range("F6").Value & ", " & Range("Q" & r).Value & " " & Range("Q6").Value
        End With
        Exit For
    End If
Next
End Sub

Chú thớt này đăng 3 bài cùng 1 chuyện, sai box cả 3 và bị khóa 2 bài. Trong 2 bài khóa đó có 1 bài bổ sung phần sau của bài này, tôi đã giải quyết xong cho chú rồi.

Tiện thể cho hỏi: sao bài bị khóa mà vẫn viết được vào đó vậy nhỉ? Hay là BQT chừa cửa hậu để bà con tiện đường lui tới?