条件下在数据表的特殊位置插入一行

Question

我一直致力于开发一种可以帮助我管理一些项目的工具。

我有一个名为 t_data 的数据表。

此数据表包含每个项目。每个项目都按季度划分（2019 年第一季度、2019 年第二季度、2019 年第三季度等）。每个季度都按可交付成果划分（并非总是相同数量的可交付成果，因此每个季度的行数也不相同）。

我在另一张表格中有一个表格（表格名称：MENU！），它允许将新的可交付成果添加到项目的四分之一中，并且我在其中放置了必要的输入，以便我可以在我需要的地方找到好的原始内容应该插入我的可交付成果。输入是项目名称（在 MENU!D10 中）和交付物相关的季度（在 MENU!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

你会注意到我是法国人，呵呵 numero_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