Nhờ các bác tư vấn về macro tiến độ

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài

4vuong4tron

Thành viên mới
Tham gia
21/5/18
Bài viết
29
Được thích
3
Nhờ các bác tư vấn xử lý các trường hợp như hình, bác Maika và bác Bebo giúp e với
(Trong phai gửi kèm đã tích hợp sẵn macro có 2 lựa chọn: lựa chọn 1 là căn chữ đỏ vào giữa, lựa chọn 2 là chữ đỏ ẩn, chữ đỏ là ô chứa công thức)
Kết quả sau khi chạy macro:
ở trường hợp 1 như hình mình thay đổi ngày kết thúc (từ 30 thành 50) chữ đỏ ko tự chỉnh, còn nếu thay đổi ngày bắt đầu <20 chữ màu đỏ sẽ mất, trước khi đổi ngày phải chuyển về 2, đổi ngày, rồi chuyển về 1(mất thêm thao tác)
ở trường hợp 3 nếu xoá cột mã (A16) chữ đỏ ko mất đi, phải chuyển về lựa chọn 2 rồi xoá mới được (mất thêm thao tác)
Cần giúp: theo như yêu cầu hình chụp
Lưu ý: ở trường hợp 2 ngày bắt đầu, kết thúc e muốn xoá luôn để vào lại (trong hình e quyên xoá ô A13 là móng cấp phối đá dăm)



Hình 4.png
 

File đính kèm

  • Tiến độ 4.1 (diễn đàn).xlsm
    491.2 KB · Đọc: 10
Lần chỉnh sửa cuối:
Có vẻ yêu cầu phát sinh vô tận ha. --=0 :D
Mình nhớ giống vụ bác sĩ gia đình trước đây, cứ mỗi câu khen tuyệt vời xong là lại thêm một chuỗi câu nhờ, anh Maika8008 phải nói bạn chủ động nghiên cứu và tự làm đi, thời gian tới nhà có việc bận chưa biết khi nào xong mới thoát.
 
Lần chỉnh sửa cuối:
Upvote 0
Tôi thấy Excel hỗ trợ làm bảng tiến độ thuận lợi với kiến thức tốt, đòi hỏi càng cao càng khó thực hiện. Còn không bạn cần sử dụng công cụ mạnh hơn là Microsoft Project.
 
Upvote 0
Tôi thấy Excel hỗ trợ làm bảng tiến độ thuận lợi với kiến thức tốt, đòi hỏi càng cao càng khó thực hiện. Còn không bạn cần sử dụng công cụ mạnh hơn là Microsoft Project.
Bảng tiến độ của Excel cũng như của MS Project đều đòi hỏi phải học và rèn luyện kinh nghiệm. Không có hỗ trợ trực tiếp và đầy đủ như VBA trên Excel - thông qua GPE.
 
Upvote 0
em quyên xem phai đính kèm bác à, nhưng vẫn chưa được bác à
- Khi chuyển chữ đậm sang chữ thường vẫn bị lỗi và màu xanh phải chuyển thành màu đen
bác xem theo đường link dưới em với
Liên kết: https://youtu.be/YxITdIYvE_U
 
Lần chỉnh sửa cuối:
Upvote 0
Upvote 0

File đính kèm

  • Tiến độ 4.1_4vuong4tron2.xlsm
    495.9 KB · Đọc: 12
Upvote 0
@4vuong4tron : Đã sửa lại code. Test file!
E test thử rồi vẫn chưa được bác à
Bất luận thế nào khi ta chạy macro ở 1 hoặc 2 thì: cứ chữ đậm thì kẻ xanh, chữ thường thì kẻ đen, chữ HOA thì kẻ tím
Nhờ bác test kỹ hộ em với: bác cứ chuyển đổi qua lại các chữ (HOA, đậm, thường) rồi ấn macro ở cả hai lựa chọn (1 và 2)
 
Lần chỉnh sửa cuối:
Upvote 0
E test thử rồi vẫn chưa được bác à
Bất luận thế nào khi ta chạy macro ở 1 hoặc 2 thì: cứ chữ đậm thì kẻ xanh, chữ thường thì kẻ đen, chữ HOA thì kẻ tím
Nhờ bác test kỹ hộ em với: bác cứ chuyển đổi qua lại các chữ (HOA, đậm, thường) rồi ấn macro ở cả hai lựa chọn (1 và 2)
Làm thực ra không khó nhưng khó ở chỗ bạn không có chủ kiến ngay từ đầu, lúc thế này lúc thế khác. Ngay trong bài này cũng đã có video báo lỗi rồi bỏ, nói sang chuyện khác.

Đậm, chữ hoa đâu thể cứ muốn là thay đổi. Đó chẳng qua là do dòng ấy đại diện cho cấp bậc của tiến độ. Tự nhiên bỏ đậm chỗ hạng mục 1, 2 rồi bảo thay đổi định dạng có điều kiện dòng đó thành đen. Bạn cứ tùy tiện như thế rồi bảo người code phải chạy theo bạn nhưng đâu có hiểu chuyện sửa code là bứt dây động rừng, nhiều lúc sửa còn mệt hơn viết lại từ đầu.

Bạn xem lại cách làm của mình đi rồi ta tiếp tục, chứ vẫn thế thì tôi nghỉ.
 
Upvote 0
...
Bạn xem lại cách làm của mình đi rồi ta tiếp tục, chứ vẫn thế thì tôi nghỉ.
Bạn theo đến giờ này thì đã đáng phục lăm rồi. Nhưng cũng có thể do bạn thiêu kinh nghiệm trên GPE.
Thực ra, đọc một hai bài đầu thì đã doán được trứng tu hú đẻ vào ổ chim sâu. Lúc đầu thì trứng tu hú in hệt trừng sáo. Nuôi lơn một vài tuần rồi sẽ thấy cảnh vợ chồng chim sâu hì hục tha mối về cho đứa con lớn gấp ba mình.
Mà nói cho cungfn thì cũng khó trách tu hú. Nếu khiing đẻ trứng in hệt ổ chủ thì đã bị loại từ đầu.
 
Upvote 0
Làm thực ra không khó nhưng khó ở chỗ bạn không có chủ kiến ngay từ đầu, lúc thế này lúc thế khác. Ngay trong bài này cũng đã có video báo lỗi rồi bỏ, nói sang chuyện khác.

Đậm, chữ hoa đâu thể cứ muốn là thay đổi. Đó chẳng qua là do dòng ấy đại diện cho cấp bậc của tiến độ. Tự nhiên bỏ đậm chỗ hạng mục 1, 2 rồi bảo thay đổi định dạng có điều kiện dòng đó thành đen. Bạn cứ tùy tiện như thế rồi bảo người code phải chạy theo bạn nhưng đâu có hiểu chuyện sửa code là bứt dây động rừng, nhiều lúc sửa còn mệt hơn viết lại từ đầu.

Bạn xem lại cách làm của mình đi rồi ta tiếp tục, chứ vẫn thế thì tôi nghỉ.
Em test đi test lại vẫn bị lỗi mà bác, bác xem thử giúp em lần này
Liên kết: https://youtu.be/oug5AEX1V-Q

Liên kết: https://youtu.be/CWm3QTrZBTg
 

File đính kèm

  • Tiến độ 4.1_4vuong4tron2.xlsm
    501 KB · Đọc: 3
Upvote 0
@4vuong4tron : Đã sửa lại code. Test file!
Bác thương thì thương cho trót, nhờ bác chỉ giúp em ý nghĩa những đoạn bôi đậm với:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range
If Target.Row > 9 And (Target.Column = 80 Or Target.Column = 81) Then
If Cells(Target.Row, 80) <> "" And Cells(Target.Row, 81) <> "" Then
For Each cel In Range("CD" & Target.Row & ":FO" & Target.Row)
If cel.MergeCells Then
TuDong 2, Target.Row (dòng này có ý nghĩa gì?)
TuDong 1, Target.Row (dòng này có ý nghĩa gì?)
Exit For
End If
Next
Range("CC" & Target.Row).Select
End If
ElseIf Target.Row > 9 And Target.Column = 1 Then
If Target.Cells(1) = "" Then TuDong 3, Target.Row (dòng này có ý nghĩa gì?)
End If
End Sub
.........................................................................................................................................................
Sub TuDong(ip As Long, rw As Long) (rw ở đây có ý nghĩa gì, chạy từ ô nào đến ô nào)
Dim lr&, j&, cell As Range, celb As Range, bd, ngay
Application.ScreenUpdating = False
Set cell = Range("CB" & rw & ":CB" & rw)
bd = cell + IIf(cell Mod 2 = 0, 1, 0)
ngay = (cell.Offset(, -1).Value - 1) / 2
If ip = 2 Then

TH1: For Each celb In Range("CD" & rw & ":FO" & rw)
If celb.MergeCells Then
Application.DisplayAlerts = False
Selection.UnMerge
Application.EnableEvents = False
celb.Offset(0, -1).Copy celb.Resize(1, Range("FO" & rw).Column - celb.Offset(0, -1).Column)
Application.EnableEvents = True
Range("CC" & rw).Select
Exit For
End If
Next
ElseIf ip = 1 Then
For Each celb In Range("CD8:FO8")
If celb = bd Then
With Cells(cell.Row, celb.Column)
Application.DisplayAlerts = False
.Resize(1, ngay).merge
.Resize(1, ngay).HorizontalAlignment = xlCenter
.Resize(1, ngay).Font.Color = vbRed
Range("CC" & rw).Select
End With
Exit For
End If
Next
ElseIf ip = 3 Then (trường hợp ip=3 là trường hợp nào?)
Application.EnableEvents = False
Range("CB" & rw & ":CC" & rw + 2).ClearContents
GoTo TH1
End If
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Bác thương thì thương cho trót, nhờ bác chỉ giúp em ý nghĩa những đoạn bôi đậm với:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range
If Target.Row > 9 And (Target.Column = 80 Or Target.Column = 81) Then
If Cells(Target.Row, 80) <> "" And Cells(Target.Row, 81) <> "" Then
For Each cel In Range("CD" & Target.Row & ":FO" & Target.Row)
If cel.MergeCells Then
TuDong 2, Target.Row (dòng này có ý nghĩa gì?)
TuDong 1, Target.Row (dòng này có ý nghĩa gì?)
Exit For
End If
Next
Range("CC" & Target.Row).Select
End If
ElseIf Target.Row > 9 And Target.Column = 1 Then
If Target.Cells(1) = "" Then TuDong 3, Target.Row (dòng này có ý nghĩa gì?)
End If
End Sub
.........................................................................................................................................................
Sub TuDong(ip As Long, rw As Long) (rw ở đây có ý nghĩa gì, chạy từ ô nào đến ô nào)
Dim lr&, j&, cell As Range, celb As Range, bd, ngay
Application.ScreenUpdating = False
Set cell = Range("CB" & rw & ":CB" & rw)
bd = cell + IIf(cell Mod 2 = 0, 1, 0)
ngay = (cell.Offset(, -1).Value - 1) / 2
If ip = 2 Then

TH1: For Each celb In Range("CD" & rw & ":FO" & rw)
If celb.MergeCells Then
Application.DisplayAlerts = False
Selection.UnMerge
Application.EnableEvents = False
celb.Offset(0, -1).Copy celb.Resize(1, Range("FO" & rw).Column - celb.Offset(0, -1).Column)
Application.EnableEvents = True
Range("CC" & rw).Select
Exit For
End If
Next
ElseIf ip = 1 Then
For Each celb In Range("CD8:FO8")
If celb = bd Then
With Cells(cell.Row, celb.Column)
Application.DisplayAlerts = False
.Resize(1, ngay).merge
.Resize(1, ngay).HorizontalAlignment = xlCenter
.Resize(1, ngay).Font.Color = vbRed
Range("CC" & rw).Select
End With
Exit For
End If
Next
ElseIf ip = 3 Then (trường hợp ip=3 là trường hợp nào?)
Application.EnableEvents = False
Range("CB" & rw & ":CC" & rw + 2).ClearContents
GoTo TH1
End If
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Bấm F9 vào 1 dòng nào đó để tạo điểm ngắt. Khi code chạy đến đó, bấm F8 chạy từng bước để biết từng dòng code làm gì.

Còn với thớt của bạn tôi không theo nữa.
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom