Lấy địa chỉ các ô có công thức sang vùng và điền kết quả sang Sheet3

[Excel my love_1]

Nhờ các anh chị giúp em Lấy địa chỉ các ô có công thức (là các ô em đã bôi màu) vùng A5:L26 của bảng tính và điền kết quả này sang cột A của Sheet3
Em xin cảm ơn ạ

 

[Quang_Hải]

Nhờ các anh chị giúp em Lấy địa chỉ các ô có công thức (là các ô em đã bôi màu) vùng A5:L26 của bảng tính và điền kết quả này sang cột A của Sheet3
Em xin cảm ơn ạ

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 Sub

 

[Excel my love_1]

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 Sub

Em sửa

MsgBox Cells(i + 5, j).Address(0, 0)

thành
[/CODE] Sheet3.Range("A" & i) = Cells(i + 5, j).Address(0, 0) [/CODE]
Nhưng kết quả ra không đầy đủ mà nó không sắp xếp được theo thứ tự các cột từ A-L là sao anh nhỉ

 

[Quang_Hải]

Em sửa

MsgBox Cells(i + 5, j).Address(0, 0)

thành
[/CODE] Sheet3.Range("A" & i) = Cells(i + 5, j).Address(0, 0) [/CODE]
Nhưng kết quả ra không đầy đủ mà nó không sắp xếp được theo thứ tự các cột từ A-L là sao anh nhỉ

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 Sub

 

[Excel my love_1]

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 Sub

Cảm ơn anh. Em vẫn đang mày mò, mà thấy khó quá

 

[Nhattanktnn]

Cả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

 

[Excel my love_1]

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

 

[Nhattanktnn]

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 Sub

 

[Excel my love_1]

ý 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 Sub

Tuyệ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.