Вставить строку в таблицу данных в специальном положении в условиях

Question

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

У меня есть таблица данных с именем t_data.

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

У меня есть форма на другом листе (название листа: МЕНЮ!), Которая позволяет добавить новый результат в Квартал проекта, и где я помещаю необходимые входные данные, чтобы я мог найти хорошее сырье, где я должен вставить мой результат. Входными данными являются имя проекта (в МЕНЮ! D10) и квартал, связанный с результатом (в МЕНЮ! D12).

Вот мой код:

Sub ajouter_un_livrable()
'
' ajouter_un_livrable Macro
' Ajoute un livrable en fonction de son challenge et de son trimestre.
'

    Dim result As Variant
    match_formula = "EQUIV(1;(t_data[Associated_challenge] = MENU!$D$10)*(t_data[Associated_quarter] = MENU!$D$12);0)"
    result = Evaluate(match_formula)

    numero_ligne = CLng(result)
    numero_ligne = numero_ligne - 2003
    Worksheets("TRT RTI Challenges").Rows(numero_ligne).insert
    'Set datasheet = Worksheets("TRT RTI Challenges").ListObjects("t_data")
    'With datasheet
        '.Cells(numero_ligne, 10).Select
        'Selection.ListObject.ListRows.Add (numero_ligne)
        'Set myNewDeliverable = .ListRows.Add(numero_ligne)
    'End With
'
End Sub

Вы заметите, что я французский Звучит цифра_Ligne, чтобы вернуть число 2015, потому что у меня ошибка 2015 ... здорово! Я не знаю, как справиться с ОЦЕНКОЙ. Как я могу принять его значение в переменную? Я много чего перепробовал, консультируюсь на многих форумах, но ничего не получается: '(

У вас есть представление о том, как я могу решить мою проблему?

Большое спасибо тому или другому, кто мне поможет или хотя бы попробует. : D

Answer 1

Я думаю, что-то вроде этого должно работать для вас:

Sub ajouter_un_livrable()

    Dim wsInput As Worksheet
    Dim rProjects As Range
    Dim rQuarters As Range
    Dim rFound As Range
    Dim vProject As Variant
    Dim vQuarter As Variant
    Dim sProjectCell As String
    Dim sQuarterCell As String
    Dim sFirst As String
    Dim bMatch As Boolean

    sProjectCell = "D10"
    sQuarterCell = "D12"

    On Error Resume Next
    Set wsInput = ActiveWorkbook.Worksheets("MENU")
    Set rProjects = Range("t_Data").ListObject.ListColumns("Associated_challenge").DataBodyRange
    Set rQuarters = Range("t_Data").ListObject.ListColumns("Associated_quarter").DataBodyRange
    On Error GoTo 0
    If wsInput Is Nothing Or rProjects Is Nothing Or rQuarters Is Nothing Then
        MsgBox "Unable to find a worksheet named 'MENU' or unable to find a table named 't_Data' in this workbook.", , "Error"
        Exit Sub
    End If

    vProject = wsInput.Range(sProjectCell).Value
    vQuarter = wsInput.Range(sQuarterCell).Value
    If Len(vProject) = 0 Then
        wsInput.Select
        wsInput.Range(sProjectCell).Select
        MsgBox "Input for Project is required.", , "Error"
        Exit Sub
    ElseIf Len(vQuarter) = 0 Then
        wsInput.Select
        wsInput.Range(sQuarterCell).Select
        MsgBox "Input for Quarter is required.", , "Error"
        Exit Sub 'No data
    End If

    bMatch = False
    Set rFound = rProjects.Find(vProject, rProjects.Cells(rProjects.Cells.Count), xlValues, xlWhole, , xlNext, False)
    If Not rFound Is Nothing Then
        sFirst = rFound.Address
        Do
            If LCase(rQuarters.Worksheet.Cells(rFound.Row, rQuarters.Column).Value) = LCase(vQuarter) Then
                bMatch = True
                Exit Do
            End If
            Set rFound = rProjects.FindNext(rFound)
        Loop While rFound.Address <> sFirst
        If bMatch Then
            rFound.EntireRow.Insert
            'Row inserted, proceed with what you want to do with the inserted row here
        End If
    Else
        MsgBox "Unable to find matching row for :" & Chr(10) & "Project: " & vProject & Chr(10) & "Quarter: " & vQuarter, , "Error"
    End If

End Sub