循环查找具有值的单元格，然后在列中搜索相同的单元格并更改其值

Question

详细问题

我正在尝试编写将遍历D列的VBA代码，

如果找到Cells（i，“ D”）=“ Good”，则代码将在整列D中搜索单元格（i，“ D”）中的值，并将其所有值更改为“ Good”

---

这是代码前的图片。

这是代码后的图片。

我的尝试：

Dim i As Integer
For i = 1 To Rows.Count


If Cells(i, "m") = "Good" Then

x = Cells(i, "m")

Next i

我认为您必须存储值（ID号），然后搜索我为其分配“ X”的值。找到“ X”后，将状态更改为“良好”

Answer 1

可能有点令人费解，但这是一个主意。

Sub f(strSearchFor as string)

Dim r As Excel.Range
Dim d As New Scripting.Dictionary

Set r = Range("a1:b10")

For Each c In r.Columns(2).Cells

    If StrComp(c.Value, strSearchFor, vbTextCompare) = 0 Then

        If Not d.Exists(c.Value) Then
            d.Add c.Offset(0, -1).Value, c.Value
        End If

    End If

Next c

For Each c In r.Columns(1).Cells

    If d.Exists(c.Value) Then
        c.Offset(0, 1).Value = d(c.Value)
    End If

Next c


Set r = Nothing
Set d = Nothing

End Sub

Answer 2

您可以添加一个帮助器列，并且仅使用公式来完成该操作：

添加以下公式，例如。在您的示例的H2中，将其拉下：

return ("Le stringhe sono vuote", None)

Answer 3

您可以尝试：

m_2

Answer 4

使用自动过滤器

Option Explicit

Sub makeGood()

    Dim i As Long, tmp As Variant
    Dim dict As Object, k As Variant

    'late bind a dictionary
    Set dict = CreateObject("scripting.dictionary")
    dict.CompareMode = vbTextCompare

    With Worksheets("sheet11")

        'remove any existing autofilters
        If .AutoFilterMode Then .AutoFilterMode = False

        'collect values from column D
        tmp = .Range(.Cells(2, "D"), .Cells(.Rows.Count, "D").End(xlUp)).Value

        'build dictionary of unique ID NUMs
        For i = LBound(tmp, 1) To UBound(tmp, 1)
            dict.Item(tmp(i, 1)) = vbNullString
        Next i

        'work with D:G range
        With .Range(.Cells(1, "D"), .Cells(.Rows.Count, "G").End(xlUp))

            'loop through unique ID NUMs
            For Each k In dict.Keys

                'autofilter on key
                .AutoFilter field:=1, Criteria1:=k, visibledropdown:=False
                'autofilter on Good
                .AutoFilter field:=4, Criteria1:="good", visibledropdown:=False

                'check for visible cells
                If Application.Subtotal(103, .Offset(1, 0).Cells) > 0 Then

                    'remove the Good autofilter
                    .AutoFilter field:=4

                    'step down off the header and put Good in the filtered cells
                    With .Resize(.Rows.Count - 1, 1).Offset(1, 3)
                        .SpecialCells(xlCellTypeVisible) = "Good"
                    End With

                End If

                'clear autofilter
                .AutoFilter field:=1
                .AutoFilter field:=4

            Next k

        End With

    End With
End Sub

Answer 5

使用arrais进行测试。使用arrais可以更快

equals