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

Question

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

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

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

我在另一个 sheet（sheet 的名称：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)*(t_data[Associated_quarter] = MENU!$D);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 听起来 return 数字 2015 因为我有一个错误 2015... 太棒了！我不知道如何管理 EVALUATE。我怎样才能把它的值变成一个变量？我尝试了很多东西，咨询了很多论坛，但没有任何效果:'(

您知道如何解决我的问题吗？

非常感谢那些能帮助我或至少尝试一下的人。 :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

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

Insert a row in a data table at a special position under conditions

excel

vba

excel-2007