Изменить цикл, чтобы записать результаты в дополнительные ячейки

Question

Некоторое время я использовал следующий код, но мне нужна помощь в внесении одного изменения. Я пытался и пытался, но это не сработает. Если кто-то может посмотреть, мое исследование говорит, что я ищу «цикл изменений, чтобы записать результаты в дополнительные ячейки». Пожалуйста, смотрите мое изображение Excel ниже.

Прямо сейчас код находит все совпадающие числа, введенные в ячейку A1, и размещает их в соответствующих ячейках L1:l12. Мне нужен код, чтобы также разместить ту же информацию только в одной из следующих ячеек: C17, C18, F17, F18. Кроме того, если код может скопировать и вставить число в ячейке под соответствующим номером (из ячейки A1), см. Пример результата ниже) в ячейку слева от вышеуказанной вставки цикла изменения в следующие ячейки: B17, B18, Е17, Е18.

Пример с ожидаемым результатом в соответствии с образцом Excel. Номер 8 был введен в ячейку А1 и найден 8 в ячейке А34. Таким образом, 8-15 будут скопированы и вставлены в L8 и C17. Также будет скопировано число 7 из ячейки A35 (следующее число) в ячейку B17. Код также сделал бы то же самое для ячейки F20 и E21. После всего копирования и вставки все ячейки B34, C34 и D34 должны быть удалены, и поэтому они будут пустыми. То же самое для F20, G20 и H20. Я надеюсь, что это понятно, если нет, пожалуйста, сообщите, и я уточню.

Мой рабочий код ниже, а моя попытка ниже этого кода.

Рабочий код:

Sub do_it()

    Dim n, sht As Worksheet, cell As Range, num, tmp, rngDest As Range

    Set sht = ActiveSheet

    n = sht.Range("A1")

    For Each cell In sht.Range("A20:A34,D20:D34,G20:G34").Cells

        tmp = cell.Offset(0, 1).Value

        If cell.Value = n And tmp Like "*#-#*" Then

            'get the first number
            num = CLng(Trim(Split(tmp, "-")(0)))
            Debug.Print "Found a positive result in " & cell.Address
 'find the next empty cell in the appropriate row
         Set rngDest = sht.Cells(num, sht.Columns.Count).End(xlToLeft).Offset(0, 1)
            'make sure not to add before col L
            If rngDest.Column < 12 Then Set rngDest = sht.Cells(num, 12)

            cell.Offset(0, 1).Copy rngDest

        End If
    Next

End Sub

Моя попытка:

Sub do_it()

    Dim n, sht As Worksheet, cell As Range, num, tmp, rngDest As Range

    Set sht = ActiveSheet

    n = sht.Range("A1")

    For Each cell In sht.Range("A20:A34,D20:D34,G20:G34").Cells

        tmp = cell.Offset(0, 1).Value

        If cell.Value = n And tmp Like "*#-#*" Then

            'get the first number
            num = CLng(Trim(Split(tmp, "-")(0)))
            Debug.Print "Found a positive result in " & cell.Address
 'find the next empty cell in the appropriate row
         Set rngDest = (“ C17, C18, F17, F18’)
             cell.Offset(0, 1).Copy rngDest

        End If
    Next

End Sub

Answer 1

Это может быть не красиво и не масштабируемо, но, поскольку я не уверен, чего именно вы пытаетесь достичь в долгосрочной перспективе, вот что должно сработать.

Прежде всего, строка For Each cell In sht.Range("A20:A34,D20:D34,G20:G34").Cells не соответствуют ячейкам, используемым в вашем примере, поэтому я изменил это на:

For Each cell In sht.Range("A20:A34,E20:E34,I20:I34").Cells

Затем я перехватил переменную tmp в конце, потому что она больше не используется, и установил ее, чтобы найти последнюю ячейку столбца, в которой было найдено совпадение, например:

Set tmp = sht.Cells(Cells(Rows.Count, cell.Column).End(xlUp).Row, cell.Column)

Затем нам нужно указать новые поля и убедиться, что мы заполняем их только один раз. Вы можете сделать это, проверив, является ли первый пустым, или со счетчиком. В любом случае, он будет работать правильно только до тех пор, пока вы найдете менее 4 совпадений.

Конечный результат был таким, измените по мере необходимости;

Sub do_it()

Dim sht As Worksheet, n As String, cell, num, tmp, rngDest As Range, i As Integer
Set sht = ActiveSheet
n = sht.Range("A1").Value
i = 0
For Each cell In sht.Range("A20:A34,E20:E34,I20:I34").Cells
    tmp = cell.Offset(0, 1).Value
    If cell.Value = n And tmp Like "*#-#*" Then
       'get the first number
        num = CLng(Trim(Split(tmp, "-")(0)))
        'find the next empty cell in the appropriate row
        Set rngDest = sht.Cells(num, sht.Columns.Count).End(xlToLeft).Offset(0, 1)
        'make sure not to add before col L
        If rngDest.Column < 12 Then Set rngDest = sht.Cells(num, 12)
        cell.Offset(0, 1).Copy rngDest

' This is getting the next number in A/E/I----
        Set tmp = cell.Offset(1, 0)

' This is filling up B17 - F18 in order until filled
        If sht.Range("B17").Value = "" Then
            sht.Range("C17").Value = cell.Offset(0, 1).Value
            sht.Range("B17").Value = tmp.Value
        ElseIf sht.Range("B18").Value = "" Then
            sht.Range("C18").Value = cell.Offset(0, 1).Value
            sht.Range("B18").Value = tmp.Value
        ElseIf sht.Range("E17").Value = "" Then
            sht.Range("F17").Value = cell.Offset(0, 1).Value
            sht.Range("E17").Value = tmp.Value
        ElseIf sht.Range("E18").Value = "" Then
            sht.Range("F18").Value = cell.Offset(0, 1).Value
            sht.Range("E18").Value = tmp.Value
        End If
  '---- This clears the BCD/FGH/JKL columns after using the value ----
        'cell.Offset(0, 1).Resize(, 3).Value = ""


   End If
Next cell
End Sub