Цикл, найти ячейки со значением, затем искать столбец для той же ячейки и изменить ее значение

Question

Подробная задача

Я пытаюсь написать код VBA, который будет проходить по столбцу D,

если он находит 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

Я думаю, вам нужно сохранить значение (идентификационный номер), а затем найти его, которому я присвоил "X". Как только "X" найден, измените статус на "Хорошо"

Answer 1

Использовать автофильтр

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 2

Вы можете попробовать:

    Option Explicit

    Sub trst()

        Dim i As Long, y As Long, LastRow As Long
        Dim ID As String, Status As String

        With ThisWorkbook.Worksheets("Sheet1") '<- Change Workbook / Sheet names

            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

            For i = 2 To LastRow

                ID = .Range("D" & i).Value
                Status = .Range("G" & i).Value

                For y = 2 To LastRow

                    If ID = .Range("D" & y).Value Then
                        .Range("G" & y).Value = Status
                    End If

                Next y

            Next i

        End With

    End Sub

Answer 3

Может быть немного запутанным, но вот идея.

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 4

Вы можете добавить вспомогательный столбец и сделать это только по формуле:

Добавьте следующую формулу, например. в H2 (вашего примера) и опустите его:

=IF(COUNTIFS(D:D,D2,G:G,"Good")>0,"Good",G2)

Answer 5

Тест с массивом. С массивом это намного быстрее

Option Explicit

Sub Subst()
    With ThisWorkbook.Sheets("Sheet1")
        Dim ArrayColumnD As Variant
        ArrayColumnD = .Range("D1:D" & .Cells(.Rows.Count, 4).End(xlUp).Row)
        Dim ArrayColumnG As Variant
        ArrayColumnG = .Range("G1:G" & .Cells(.Rows.Count, 7).End(xlUp).Row)

        Dim ID As String
        Dim RowActual As Long
        Dim RowTest As Long
        For RowActual = 2 To UBound(ArrayColumnD)
            If ArrayColumnG(RowActual, 1) = "Good" Then
                ID = ArrayColumnD(RowActual, 1)
                For RowTest = 2 To UBound(ArrayColumnD)
                    If ArrayColumnD(RowTest, 1) = ID Then
                        ArrayColumnG(RowTest, 1) = "Good"
                    End If
                Next RowTest
            End If
        Next RowActual

        .Range("G1:G" & .Cells(.Rows.Count, 7).End(xlUp).Row) = ArrayColumnG
    End With
End Sub