需要动态VBA公式

Question

我正在尝试为命名变量 a 和 b 输入动态公式。该公式将包含以下逻辑：如果 a（定义如下）为空白，则 b（定义如下）否则为 a。应将结果输入到名为 Client ID 的新列中。我能够创建新列客户端 ID，但由于需要调试代码停止的公式，因此遇到了问题。 我试图以不同的方式定义我的变量和范围，但仍然有问题。

感谢任何帮助。谢谢！

Sub baSTEP1formulaINDEV()

'A column named Client ID already exists

   Dim sht As Worksheet
   Dim StartCell As Range
   Dim LastR As Long
   Dim LastC As Long

   Set sht = Worksheets("Group Activity")
   Set StartCell = Range("A1")

 Dim a As Integer
    a = Cells.Find(What:="*Client: Client / Contact ID*", After:=Range("A2"), LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False).Column
    ActiveWindow.Activate

  Dim b As Integer
    b = Cells.Find(What:="*Case Participant Client ID*", After:=Range("A2"), LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False).Column
    ActiveWindow.Activate

 'Find Last Row and Column
  LastR = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
  LastC = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column

Range(Selection).Formula = _
"=IF(ISBLANK(a),b,a)"


End Sub

Answer 1

对于动态公式，您最好使用 function() 而不是 sub()，此解决方案可能会对您有所帮助：在这种情况下，您只需在所需的任何单元格中输入自定义公式，例如，您可以在单元格 E1 中输入此公式：=customSearch(A1:B4) Range A1:B4（例如）可以通过鼠标拖动来选择

 Function customSearch(SearchRange As Range) As String
    Dim rng As Range
    Dim aFound As Boolean, bFound As Boolean
    Dim aText, bText
    Dim aAddress, bAddress
    aText = "*Client: Client / Contact ID*"
    bText = "*Case Participant Client ID*"
    aFound = False
    bFound = False
    
    For Each rng In SearchRange
        If InStr(rng, aText) > 0 Then
            aAddress = rng.Address
            aFound = True
            Exit For
        End If
    Next
    
    If aFound = False Then
        For Each rng In SearchRange
            If InStr(rng, bText) > 0 Then
                bAddress = rng.Address
                bFound = True
                Exit For
            End If
        Next
    End If
    
    If aFound = True Then
        customSearch = aAddress
    Else
        customSearch = bAddress
    End If
End Function

此评论可能对功能有所帮助。

您可以公开设置您的功能并使用类型“*.xla”（Excel 插件）保存您的文件，然后您可以在您想要的每个工作簿中使用此功能。