Преобразование «For» в цикл «Для каждого»

Question

У меня есть код VBA, который смотрит на последнюю новую строку для других экземпляров записей в столбцах D и E строки на листе. Когда оба экземпляра столбца найдены, макрос копирует данные из столбца F существующей строки в столбец F новой строки.

Однако макрос является ограничительным, поскольку он заканчивается после нахождения первого экземпляра этого. Я хотел бы, чтобы макрос зацикливался до тех пор, пока не будут найдены все экземпляры.

Я решил, что наилучшим способом было бы преобразование петли For в цикл For each, но, похоже, не может заставить попытки кода работать. Любые указатели были бы очень полезны!

Sub test() 
    Dim N As Long 
    N = Cells(Rows.Count, "D").End(xlUp).Row 
    Dim i As Long 
    d = Cells(N, "D").Value 
    e = Cells(N, "E").Value 

    For i = N - 1 To 1 Step -1 
     dt = Cells(i, "D").Value 
     et = Cells(i, "E").Value 

     If d = dt And e = et Then 
      Cells(N, "F").Value = Cells(i, "F").Value 
     End If 
    Next i   
End Sub 

Answer 1

Право, работающий от Jean-François Corbett's answer, который хранит содержимое в массивах, прежде чем приступить к эффективности, но адаптируя его для проверки всех повторяющихся строк в прогрессивной моды, снизу вверх. Вы получаете что-то вроде этого:

Public Sub FillDuplicates() 
    Dim lastRow As Integer 
    Dim dColumn As Variant, eColumn As Variant, fColumn As Variant 
    Dim rowAltered() As Boolean 

    'Find the last row in Column D with content 
    lastRow = Cells(Rows.Count, "D").End(xlUp).Row 

    'Acquire data from columns: D, E & F in to arrays 
    dColumn = Range("D1").Resize(lastRow, 1).Value 
    eColumn = Range("E1").Resize(lastRow, 1).Value 
    fColumn = Range("F1").Resize(lastRow, 1).Value 

    ReDim rowAltered(1 To lastRow) 

    'Loop through all rows from bottom to top, using each D/E column value as a key 
    For cKeyRow = lastRow To 1 Step -1 

     'Ignore rows that have already been replaced 
     If Not rowAltered(cKeyRow) Then 

      'Loop through all rows above current key row looking for matches 
      For cSearchRow = cKeyRow To 1 Step -1 

       'If the row is a match and has not previously been changed, alter it 
       If Not rowAltered(cSearchRow) And dColumn(cKeyRow, 1) = dColumn(cSearchRow, 1) And eColumn(cKeyRow, 1) = eColumn(cSearchRow, 1) Then 
        fColumn(cSearchRow, 1) = fColumn(cKeyRow, 1) 
        rowAltered(cSearchRow) = True 
       End If 

      Next cSearchRow 

     End If 

    Next cKeyRow 

    'Store the amended F column back in the spreadsheet 
    Range("F1").Resize(lastRow, 1) = fColumn 
End Sub 

Примечания, все работы с rowAltered для определения строк, которые были обработаны время просто сейв обработки. Это было бы необязательно, так как нижестоящее действие процесса заменило бы будущие ключевые значения строк с более низкими дубликатами по мере их появления. Просто он будет выполнять замены несколько раз для каждого последующего дублирования страницы. Проверка rowAltered предотвращает это.

Если вы оставили данные в электронной таблице, вы можете использовать методы .Find(), возможно, на столбцах, чтобы найти дубликаты, а не внутренний цикл. Но я сомневаюсь, что это будет более эффективно.

Answer 2

Я бы сказал, что

• последовательно обрабатывает список - особенно с условиями выхода - лучше сделать с классическими петлями (Do/Loop, While, For/Next)

• использовать For Each ... In/Next вас необходимо иметь коллекцию (например, диапазон, список листов - все, что заканчивается на с '), и имейте в виду, что это не g что этот список обрабатывается сверху вниз-влево-вправо ... нет предопределенной или выбираемой последовательности.

Итак, в соответствии с логикой вы описали, я не вижу смысла меняющийся For/Next в For Each ... In/Next.

Answer 3

Я не вижу причин переезжать в For Each в вашем случае.

Что вам нужно сделать, это прочитать все, начиная с вашего листа, до массивов сразу, а затем пропустить эти массивы. Это намного эффективнее, чем цикл через ячейки. То же самое касается написания на листе - это медленно и неэффективно. Просто напишите конечный результат один раз, а не многократно пишите на лист.

Пример:

Sub test() 
    Dim d, e, dt, et, ft, x 
    Dim i As Long 
    Dim N As Long 

    'Read everything from sheet into arrays 
    N = Cells(Rows.Count, "D").End(xlUp).Row 
    d = Cells(N, "D").Value 
    e = Cells(N, "E").Value 
    dt = Range("D1").Resize(N, 1).Value 
    et = Range("E1").Resize(N, 1).Value 
    ft = Range("F1").Resize(N, 1).Value 

    'Loop through arrays 
    For i = N - 1 To 1 Step -1 
     If d = dt(i, 1) And e = et(i, 1) Then 
      x = ft(i, 1) 
     End If 
    Next i 

    'Write result back to sheet 
    Cells(N, "F").Value = x 
End Sub 

Answer 4

Вам нужно отслеживать новую строку, чтобы каждый раз, когда вы находите дубликат, вы увеличиваете новый ряд на 1.Чтобы расшифровать свой код:

Sub test() 
    Dim N As Long 
    Dim CurRow As Long 
    N = Cells(Rows.Count, "D").End(xlUp).Row 
    CurRow = N 
    Dim i As Long 
    d = Cells(N, "D").Value 
    e = Cells(N, "E").Value 

    For i = N - 1 To 1 Step -1 
     dt = Cells(i, "D").Value 
     et = Cells(i, "E").Value 

     If d = dt And e = et Then 
      Cells(CurRow, "F").Value = Cells(i, "F").Value 
      CurRow = CurRow + 1 
     End If 
    Next i   
End Sub