Mình định hướng cho bạn cách lấy địa chỉ ô chứa công thức theo yêu cầu bài này nhé
Sub abc()
Dim sArr(), i As Long, j As Long
sArr = Range("A6:L1000").Formula
For j = 1 To UBound(sArr, 2) Step 2
For i = 1 To UBound(sArr)
If InStr(sArr(i, j), "=") Then
MsgBox Cells(i + 5, j).Address(0, 0)
End If
Next
Next
End SubEm sửa
MsgBox Cells(i + 5, j).Address(0, 0)Khi nào bạn giỏi edit code của người khác thì khỏe hẳn ra nhé
Sub FillColor()
Dim sArr(), i As Long, j As Long
sArr = Sheets("Fill Color").Range("A6:L1000").Formula
For j = 1 To UBound(sArr, 2) Step 2
For i = 1 To UBound(sArr)
If InStr(sArr(i, j), "=") Then
Sheet3.Range("A" & Rows.Count).End(3)(2) = Cells(i + 5, j).Address(0, 0)
End If
Next
Next
End SubCảm ơn anh. Em vẫn đang mày mò, mà thấy khó quá
nhưng bạn đã có một code tô màu ô có công thức rồi, thì nên tận dụng khi lặp thì đưa địa chỉ đó vào mảng rồi gán vào sheet3 luôn, đỡ chạy 2 lần
Trình độ mình chỉ mới dừng lại ở chạy vòng lặp đơn sơ kiểu bôi màu đó chưa biết dùng đến mảng. Bạn giúp mình theo cách của bạn với. Cảm ơn bạn
ý là mình nói vậy, không mảng cũng được nhưng lặp mấy ô đó thì tận dụng gán luôn. Mất công 2 code. Bạn thử code này xem (dán vào module nhé)
Option Explicit
Option Compare Text
Sub Taoketqua1()
Dim LastRow&, LastCol&, I&, J&, K&
Const Rws As Long = 5
Const Col As Long = 1
Application.ScreenUpdating = False
With Sheets("Fill color")
LastCol = .Cells(Rws, .Columns.Count).End(xlToLeft).Column
For I = Col To LastCol
If .Cells(Rws, I) = "thu" Then
LastRow = .Cells(.Rows.Count, I).End(xlUp).Row
If LastRow < Rws + 1 Then Exit Sub
For J = Rws + 1 To LastRow
If .Cells(J, I).HasFormula = True Then
.Cells(J, I).Interior.Color = 345545
K = K + 1
Sheets("Sheet3").Cells(K, "A") = .Cells(J, I).Address(0, 0)
End If
Next J
End If
Next I
End With
Application.ScreenUpdating = True
MsgBox ("Finish!!!")
End SubTuyệt vời! Đúng cái hướng suy nghĩ mình đang mày mò từ chiều mà không ra luôn.
