Перезапись кода и только возвращение последнего значения

Question

Я очень плохо знаком с кодированием и VBA в целом.

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

Option Explicit
Sub automated_gr_lookup()

Dim l As Variant
Dim gr As Variant
Dim st As Long
Dim en As Long
Dim c1 As Long
Dim c2 As Long
Dim c As Integer
Dim d As Integer

Sheets("Geotechnical Risk Register").Select

Application.ScreenUpdating = False

For c = 1 To 413
    Sheets("Geotechnical Risk Register").Select
    'gr = geotechnical risk'
    Cells(8 + c, 2).Select
    gr = Selection.Value
    'For M002'
    Cells(8 + c, 3).Select
    l = Selection.Value
        If l = "M002" Then

            'Start Chainage for GRR ID'
            Cells(8 + c, 4).Select
            st = Selection.Value
            'End Chainage for GRR ID'
            Cells(8 + c, 5).Select
            en = Selection.Value

            Sheets("DES P14 M002").Select
            For d = 1 To 74
            'Start Chainage for DES ID'
            Cells(2 + d, 3).Select
            c1 = Selection.Value
            'End Chainage for DES ID'
            Cells(2 + d, 4).Select
            c2 = Selection.Value

            'Conditions 1 to 4 - Geotechnical Risk falling within the Design Element Extent'
            If (en > c1 And en < c2) Or (st > c1 And en < c2) Or (st > c1 And st < c2) Or (st < c1 And en > c2) Then
                Sheets("DES P14 M002").Select
                Cells(2 + d, 8).Value = gr


            End If
            Next d


        End If


Next c

End Sub

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

Answer 1

(ЭТО НЕ ОТВЕТ, НО ДЛИТЕЛЬНО ЗА КОММЕНТАРИЙ. ПОЖАЛУЙСТА, ПОНИМАЙТЕ. Я удалю его, когда мы сможем получить какие-либо разъяснения)

Это ваш код ...

Option Explicit
Sub automated_gr_lookup()

Dim l As Variant
Dim gr As Variant
Dim st As Long
Dim en As Long
Dim c1 As Long
Dim c2 As Long
Dim c As Integer
Dim d As Integer



Application.ScreenUpdating = False

For c = 1 To 413
    Sheets("Geotechnical Risk Register").Activate
    gr = Cells(8 + c, 2).Value
    l = Cells(8 + c, 3).Value
        If l = "M002" Then
            st = Cells(8 + c, 4).Value
            en = Cells(8 + c, 5).Value
            Sheets("DES P14 M002").Activate
            For d = 1 To 74
                c1 = Cells(2 + d, 3).Value
                c2 = Cells(2 + d, 4).Value
                If (en > c1 And en < c2) Or (st > c1 And en < c2) Or _
                                            (st > c1 And st < c2) Or (st < c1 And en > c2) Then
                    Cells(2 + d, 8).Value = gr
                End If
            Next d
        End If
Next c
End Sub

Без всего выбранного персонала и комментариев, вы можете заметить, что вы просто даете значения gr и l, когда l = "M002", тогда вы даете значения st, en, c1 и c2 и только когда условие соответствуетзатем вы заполняете свой столбец H на листе «DES P14 M002».

Но (без какой-либо информации о ваших данных) у вас есть риск поместить различные данные gr в одну и ту же ячейку столбца H.идея?