Miền Cát Trắng
Thành viên hoạt động



- Tham gia
- 18/5/13
- Bài viết
- 171
- Được thích
- 37
Muốn VBA thì thử chạy Sub này coi sao:Xin kính chào mọi người.
Tôi đang gặp phải một vấn đề như đã nêu rõ trong file đính kèm.
Nếu sử dụng chức năng CF thì tôi có thể làm được nhưng tôi muốn tìm hiểu khi làm bằng vba. Mong mọi người giúp đỡ.
Xin cảm ơn!
Public Sub GPE()
Dim Rng As Range, Cll As Range, DK As Long
With Sheet1
DK = .[C5].Value
.[C8:K1000].Interior.ColorIndex = 0
Set Rng = .Range(.[C8], .[C8].End(xlDown))
For Each Cll In Rng
If Cll.Value = DK Then
Cll.Resize(, 9).Interior.ColorIndex = 6
MsgBox "Ma oi, Ma oi ..... Cuu con!"
End If
Next Cll
End With
Set Rng = Nothing
End Sub
Trước hết xin cảm Thầy đã vui vẻ giúp đỡ!Muốn VBA thì thử chạy Sub này coi sao:
PHP:Public Sub GPE() Dim Rng As Range, Cll As Range, DK As Long With Sheet1 DK = .[C5].Value .[C8:K1000].Interior.ColorIndex = 0 Set Rng = .Range(.[C8], .[C8].End(xlDown)) For Each Cll In Rng If Cll.Value = DK Then Cll.Resize(, 9).Interior.ColorIndex = 6 MsgBox "Ma oi, Ma oi ..... Cuu con!" End If Next Cll End With Set Rng = Nothing End Sub
Xem Cái "má ơi...má ơi ..." này thử xem, sao nhiều cái "oái oăm" vậy?Trước hết xin cảm Thầy đã vui vẻ giúp đỡ!
Về cơ bản thì code của Thầy viết rất đúng ý với em đã nêu tuy nhiên còn một chút xíu nữa mong Thầy sửa giúp cho ạ. Đó là các cột màu xanh trong khung vẫn giữ nguyên màu xanh.
Nghĩa là điều kiện màu vàng chỉ hoạt động trong vùng [C8:E17,G8:I17,K8:K17] thôi ạ!
------------------
Em định thêm một dòng code tô lại các vùng màu xanh này. Nhưng nếu như vậy thì nghĩa phải thêm 1 công đoạn phải không ạ. Mong Thầy chỉ dẫn thêm để không phải thêm công đoạn này nữa ạ.
Cảm ơn Thầy!
Public Sub GPE()
Dim Rng As Range, Cll As Range, DK As Long, MaOI As Range
With Sheet1
DK = .[C5].Value
Set MaOI = Union(.[C8:E17], .[G8:I17], .[K8:K17])
MaOI.Interior.ColorIndex = 0
Set Rng = .Range(.[C8], .[C8].End(xlDown))
For Each Cll In Rng
If Cll.Value = DK Then
Set MaOI = Union(Cll.Resize(, 3), Cll.Offset(, 4).Resize(, 3), Cll.Offset(, 8))
MaOI.Interior.ColorIndex = 6
MsgBox "Ma oi, Ma oi ..... Cuu con!"
End If
Next Cll
End With
Set Rng = Nothing
Set MaOI = Nothing
End Sub
Xem Cái "má ơi...má ơi ..." này thử xem, sao nhiều cái "oái oăm" vậy?
PHP:Public Sub GPE() Dim Rng As Range, Cll As Range, DK As Long, MaOI As Range With Sheet1 DK = .[C5].Value Set MaOI = Union(.[C8:E17], .[G8:I17], .[K8:K17]) MaOI.Interior.ColorIndex = 0 Set Rng = .Range(.[C8], .[C8].End(xlDown)) For Each Cll In Rng If Cll.Value = DK Then Set MaOI = Union(Cll.Resize(, 3), Cll.Offset(, 4).Resize(, 3), Cll.Offset(, 8)) MaOI.Interior.ColorIndex = 6 MsgBox "Ma oi, Ma oi ..... Cuu con!" End If Next Cll End With Set Rng = Nothing Set MaOI = Nothing End Sub
Xem Cái "má ơi...má ơi ..." này thử xem, sao nhiều cái "oái oăm" vậy?
PHP:Public Sub GPE() Dim Rng As Range, Cll As Range, DK As Long, MaOI As Range With Sheet1 DK = .[C5].Value Set MaOI = Union(.[C8:E17], .[G8:I17], .[K8:K17]) MaOI.Interior.ColorIndex = 0 Set Rng = .Range(.[C8], .[C8].End(xlDown)) For Each Cll In Rng If Cll.Value = DK Then Set MaOI = Union(Cll.Resize(, 3), Cll.Offset(, 4).Resize(, 3), Cll.Offset(, 8)) MaOI.Interior.ColorIndex = 6 MsgBox "Ma oi, Ma oi ..... Cuu con!" End If Next Cll End With Set Rng = Nothing Set MaOI = Nothing End Sub
Set MaOI = Union([B].[C8:E17], .[G8:I17], .[K8:K17][/B])
Set Rng = .Range(.[C8], .[C8][COLOR=#ff0000][B].End(xlDown)[/B][/COLOR])
Chời ơi!Nhưng mà với cái đoạn này của Thầy:
Mà kết hợp với đoạn này:Mã:Set MaOI = Union([B].[C8:E17], .[G8:I17], .[K8:K17][/B])
thì em nghĩ là chưa hợp lý bởi vì nếu điều kiện khi tô màu vàng ngoài vùng MaOI thì sẽ không thể trở về 0 được khi ngoài vùng MaOI này không còn đúng với điều kiện ạ.Mã:Set Rng = .Range(.[C8], .[C8][COLOR=#ff0000][B].End(xlDown)[/B][/COLOR])
Biểu sao làm vậy, kết quả có đúng không?Nghĩa là điều kiện màu vàng chỉ hoạt động trong vùng [C8:E17,G8:I17,K8:K17] thôi ạ!
Code dzì:Rng.Offset(, 3).Interior.ColorIndex = 50
Rng.Offset(, 7).Interior.ColorIndex = 50
Public Sub GPE()
Dim Rng As Range, Cll As Range, DK As Long
With Sheet1
DK = .[C5].Value
.[C8:K1000].Interior.ColorIndex = 0
Set Rng = .Range(.[C8], .[C8].End(xlDown))
For Each Cll In Rng
If Cll.Value = DK Then
Cll.Resize(, 9).Interior.ColorIndex = 6
MsgBox "Ma oi, Ma oi ..... Cuu con!"
End If
Next Cll
Rng.Offset(, 3).Interior.ColorIndex = 50
Rng.Offset(, 7).Interior.ColorIndex = 50
End With
Set Rng = Nothing
End Sub
Lỡ "má ơi" muốn thay đổi 2 cột F và J bằng cái màu "má ơi" nào khác tuỳ thích bằng thủ công thì "má ơi... má ơi" tiếp tục.Má ơi !!! Cái bài này cứ Má ơi như lúc đầu, Má ơi xong thì chèn 2 dòng này vào cho nhẹ nhàng
Code dzì:
Híc, Má ơiMã:Public Sub GPE() Dim Rng As Range, Cll As Range, DK As Long With Sheet1 DK = .[C5].Value .[C8:K1000].Interior.ColorIndex = 0 Set Rng = .Range(.[C8], .[C8].End(xlDown)) For Each Cll In Rng If Cll.Value = DK Then Cll.Resize(, 9).Interior.ColorIndex = 6 MsgBox "Ma oi, Ma oi ..... Cuu con!" End If Next Cll Rng.Offset(, 3).Interior.ColorIndex = 50 Rng.Offset(, 7).Interior.ColorIndex = 50 End With Set Rng = Nothing End Sub
Thân
Thì trước khi Má Ơi tìm em trùng tô màu vàng, mình cho chạy theo cột trong vùng dữ liệu,Má Ơi điểm mặt cột nào có màu & màu gì gom bỏ vào một biến để dành đóLỡ "má ơi" muốn thay đổi 2 cột F và J bằng cái màu "má ơi" nào khác tuỳ thích bằng thủ công thì "má ơi... má ơi" tiếp tục.
Híc!
Ẹc..
Record macro thôi! Chứ đề không có điều kiện này thích tô sao tô rồiXin chào cả nhà
Tôi đang muốn tô màu theo từng vùng (như file đính kèm). Tôi muốn tìm hiểu khi sử dụng bằng vba. Mong mọi người giúp đỡ.
Xin cảm ơn!
không có điều kiện cụ thể nào cho vùng nào,thì bạn xem cái code phía trên ấy lệnh tô màu đó rồi cứ phang thẳng cái vùng đó cho màu đó là được chứ nhìn cái file của bạn thì chưa biết làm như thế nào cho tối ưu cả View attachment 248284Mã:sheet1.Range("A34:G44").Interior.ColorIndex = 6
Cám ơn Bạn đã hướng dẫn. Ý mình đây là có đoạn code nào hướng dẫn tô màu theo vùng.
Vd: từ ô A6 -> G12: tô màu xanh dương
từ ô A13 -> G21: tô màu vàng
từ ô A22 -> G44: tô màu xanh lá
sheet1.Range("A34:G44")
.Interior.ColorIndex = 6
tự đông kiểu như thế nào đã chứ,tự động cũng cần có điêu kiện để giới hạn vùng,chứ còn không nó chạy tùm lum làm sao bạn?Mình đã tô được màu từng cùng cố định. Nhưng mình muốn dùng code để tự động tô mà không chỉnh từ vùng
Cái tối thiểu để tính toán "tự động" dù là công thức hay vba là cái điều kiện mà bạn ấy cũng không trình bày ra. Vậy mà bạn ấy cứ muốn "tự động", không hiểu tự động sao luônEnd Sub[/CODE]
tự đông kiểu như thế nào đã chứ,tự động cũng cần có điêu kiện để giới hạn vùng,chứ còn không nó chạy tùm lum làm sao bạn?
À tức là cái chỗ dài thòng lòng đó nó gần gần như này đấy bạn:Cám ơn cả nhà, Mình đã làm được
Mình tô màu theo vùng và chạy code mẫu, lấy code mẫu pass vô và điều chỉnh ô lại theo mong muốn
Range("A6:G14").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 13434879
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("A15:G23").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 13434828
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ActiveWindow.SmallScroll Down:=15
Range("A24:G50").Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16772300
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("B21").Select
ActiveWindow.SmallScroll Down:=-21
Range("A6:G50").Select
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
Range("F16").Select
ActiveWindow.SmallScroll Down:=-30
Range("F11").Select
ActiveWindow.SmallScroll Down:=-42
Range("F11").Select
Sub ToMauSieuTuDong()
Range("A6:G14").Interior.ColorIndex = 36
Range("A15:G23").Interior.ColorIndex = 20
Range("A24:G50").Interior.ColorIndex = 37
Range("A6:G50").Borders.LineStyle = xlContinuous
End Sub
Thử code dưới đâyCho em hỏi cách tô màu với:
Nếu thu được tiền liên tục trong 10 ngày thì ngày thứ 7 bôi màu cam,
nếu 14 ngày liên tục thì ngày thứ 7 và ngày thứ 14 bôi màu cam,
Nếu 21 ngày liên tục thì ngày thứ 7, 14 và 21 bôi màu cam
Nếu 28 ngày liên tục thì ngày thứ 7, 14, 21, 28 bôi màu cam
nếu ngày nào không thu được tiền thì bôi màu vàng
còn lại các ngày màu trắng
Tính tổng số tiền các ngày màu cam của từng người
cám ơn các anh chị
Option Explicit
Sub A_mau_tien()
Dim DL, tien
Dim i, j, k, t
With Sheet1
DL = .Range("A2", .Range("AF" & Rows.Count).End(xlUp))
.Range("A2", .Range("AF" & Rows.Count).End(xlUp)).ClearFormats
.Range("A2", .Range("AF" & Rows.Count).End(xlUp)).Borders.LineStyle = 1
For i = 1 To UBound(DL)
k = 0
tien = 0
For j = 2 To 32
If DL(i, j) > 0 Then
k = k + 1
If k = 10 Then
t = j - 4
Else
If k > 10 And k Mod 7 = 0 Then t = j - 1
End If
If t Then
'tien = tien + DL(i, j)
tien = tien + DL(i, t + 1)'<--sua lai
.Range("A" & i + 1).Offset(, t).Select
Macro1
t = 0
End If
Else
.Range("A" & i + 1).Offset(, j - 1).Select
Macro2
k = 0
End If
Next j
.Range("AG" & i + 1) = tien
Next i
End With
End Sub
Sub Macro1()
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
Sub Macro2()
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
Đoạn code trên cộng tiền bị lỗi, sorry.Bác ChaoQuay sửa hộ em cái này với, khi đưa code của bác vào dữ liệu thì em đã sửa lại những cái em biết thì thấy phần tô màu đúng rồi, còn phần tính tổng theo màu vẫn gặp khó khăn, em thấy nó tự lấy dữ liệu ở ô số 10 đem cộng với những ô màu cam khác chứ không phải ở ô thứ 7 có màu cam
If t Then
'tien = tien + DL(i, j)
tien = tien + DL(i, t + 1)
Đoạn code trên cộng tiền bị lỗi, sorry.
Bạn xem lại bên dưới, thay dòng trên = dòng dưới là được
Mã:If t Then 'tien = tien + DL(i, j) tien = tien + DL(i, t + 1)
Thanks Bac chuẩn rồi bác. Cám ơn bác đã giúp đỡ em nhiệt tìnhĐoạn code trên cộng tiền bị lỗi, sorry.
Bạn xem lại bên dưới, thay dòng trên = dòng dưới là được
Mã:If t Then 'tien = tien + DL(i, j) tien = tien + DL(i, t + 1)
Hôm trước mình cũng làm thế nhưng sau khi CF xong nó xóa mất tiêu các định dạng của mình ( Có lẽ do lỗi của file ). Cảm ơn bạn đã hỗ trợ.Cái này dùng thử CF kết quả cũng được.
Hôm trước mình cũng làm thế nhưng sau khi CF xong nó xóa mất tiêu các định dạng của mình ( Có lẽ do lỗi của file. File sử dụng vba để Highlight ). Cảm ơn bạn đã hỗ trợ.
Public Sub GPE() Dim Rng As Range, Cll As Range, DK As Long With Sheet1 DK = .[C5].Value .[C8:K1000].Interior.ColorIndex = 0 Set Rng = .Range(.[C8], .[C8].End(xlDown)) For Each Cll In Rng If Cll.Value = DK Then Cll.Resize(, 9).Interior.ColorIndex = 6 MsgBox "Ma oi, Ma oi ..... Cuu con!" End If Next Cll End With
nếu thay C5 bằng 1 vùng dữ liệu từ c5 tới c 200 thì sao ạ?Xem Cái "má ơi...má ơi ..." này thử xem, sao nhiều cái "oái oăm" vậy?
PHP:Public Sub GPE() Dim Rng As Range, Cll As Range, DK As Long, MaOI As Range With Sheet1 DK = .[C5].Value Set MaOI = Union(.[C8:E17], .[G8:I17], .[K8:K17]) MaOI.Interior.ColorIndex = 0 Set Rng = .Range(.[C8], .[C8].End(xlDown)) For Each Cll In Rng If Cll.Value = DK Then Set MaOI = Union(Cll.Resize(, 3), Cll.Offset(, 4).Resize(, 3), Cll.Offset(, 8)) MaOI.Interior.ColorIndex = 6 MsgBox "Ma oi, Ma oi ..... Cuu con!" End If Next Cll End With Set Rng = Nothing Set MaOI = Nothing End Sub
Cứ thử thì sẽ biết thôi.nếu thay C5 bằng 1 vùng dữ liệu từ c5 tới c 200 thì sao ạ?
Nhưng em không biết khai báo sao cho OK ạ vì đã thử khai báo rồi nhưng không được.Cứ thử thì sẽ biết thôi.
Trong đoạn code trên làm gì có biến nào tên là "OK" đâu mà cần khai báo cho nó hả bạn.Nhưng em không biết khai báo sao cho OK ạ vì đã thử khai báo rồi nhưng không được.
Nghĩa là như nàyTrong đoạn code trên làm gì có biến nào tên là "OK" đâu mà cần khai báo cho nó hả bạn.
Đầu tiên hãy sửa từ viết tắt rồi bàn tiếp nhỉ.Giờ e muốn
File của chủ bài đăng có 1 ô điều kiện & 1 vùng cần xem xét để tô màu;Nghĩa là như này
DK = .[C5].Value
Giờ e muốn thay C5 bằng 1 vùng dữ liệu chứ không phải 1 ô ( từ ô C5 đến ô C200 ) thì viết như nào ạ?
Vậy phải đợi Nga và Ukraine đàm phán đã anh ơi.File của chủ bài đăng có 1 ô điều kiện & 1 vùng cần xem xét để tô màu;
Cái chính là vùng xem xét tô màu đang là [C8:K17]
Như bạn nêu là ô điều kiện biến thành vùng điều kiện & đã ghi rõ là [C5:C200]
Vậy là vùng điều kiện đã chồng lấn lên vùng cần khảo sát để tô màu
Chuyện này dễ diễn ra chiến tranh nếu 2 vùng đó là lãnh thổ của 2 nước láng giềng thù địch nhau!
Trước tiên là bạn phải tách phần chồng lấn của 2 vùng này ra rạch ròi cái đã!
sao bác này hay bắt bẻ thế nhỉĐầu tiên hãy sửa từ viết tắt rồi bàn tiếp nhỉ.
vâng, đúng là nếu để từ C5 đến C200 thì bị lẫn lộn giữa 2 vùng điều kiện và vùng cần tô màu, nhưng ý của mình đang là muốn vùng điều kiện cũng là nhiều giá trị khác nhau chứ k phải là 1 giá trị mặc định tại ô C5 như đề bài ban đầuVậy phải đợi Nga và Ukraine đàm phán đã anh ơi.
Ở chiều ngược lại, cũng có khi ngầm hiểu là được rồi như bạn nói, sẽ phải ăn chưỡi te tua đó!. . . . . .Nhiều khi đọc câu hỏi chỉ cần hiểu ý của người hỏi là được rồi, sao các bác cứ phải đi bắt bẻ người hỏi hoài vậy, người ta không biết mới lên diễn đàn hỏi mà gặp được 10 người biết nhưng cứ bắt bẻ như này chắc hộc máu mất
Người đọc không hiểu mới phải hỏi lại, chứ có phải người đọc nào cũng được tinh thông lanh lợi như người phải đi hỏi đâu cơ chứ.đọc câu hỏi chỉ cần hiểu ý của người hỏi là được rồi, người ta không biết mới lên diễn đàn hỏi