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

在条件

1 个答案: