在公式 vba 中使用最新的工作表

Question

我正在使用应引用系列中最新工作表的 Excel 工作表 Inlife (n)，我得到了 VBA，因此如果我手动告诉它要使用哪个工作表，它就会替换参考。我不能简单地使用最后一张或所有张中的第五张或其他东西。 但是，该位置始终是工作表 RG 之前的工作表。我尝试使用与复制和粘贴相同的代码：=before... 但这并没有让我到任何地方，也没有像下面这样计算。

   Dim result As Integer 
   result = Count(If ws.Name = "Inlife" Or ws.Name Like "Inlife (*)")

ActiveSheet.Select

        Dim rng As Range, cel As Range
    Set rng = ActiveSheet.Range("B3:B25")
    

    For Each cel In rng
    cel.Formula = Replace(cel.Formula, "Inlife", "'Inlife (result)'")

    Next

这根本不起作用，但我希望你能理解我的意图。 （我确信这看起来很荒谬，但我不知道如何描述我的问题）

希望你能帮到我

Answer 1

您可以按顺序遍历工作表，如果其名称以“Inlife”开头，则将最新的工作表分配给变量。循环完成后，变量将设置为名称以“Inlife”开头的最后一张表。

Sub getinlife()

    Dim last_inlife_sheet As Worksheet
    
    For Each ws In ThisWorkbook.Worksheets
        ' Check if worksheet name begins with "Inlife"
        If InStr(1, ws.Name, "Inlife") = 1 Then
            Set last_inlife_sheet = ws
        End If
    Next ws
    
    (your code)
    
End Sub

我使用我用以下工作表名称模拟的工作簿对此进行了测试：

并验证在运行循环后，last_inlife_sheet 被设置为名为 Inlife (3) 的工作表。

Answer 2

更新公式工作表参考

Option Explicit

Sub UpdateFormulaWorksheetReferences()
    On Error GoTo ClearError
    Const ProcName As String = "UpdateFormulaWorksheetReferences"
    
    Const dfCellAddress As String = "B3"
    Const ashName As String = "RG"
    Const swsBaseName As String = "Inlife"
    
    ' Create a reference to the Destination worksheet.
    Dim dws As Worksheet: Set dws = ActiveSheet
    
    ' Check if there is any data in the destination column.
    Dim dfCell As Range: Set dfCell = dws.Range(dfCellAddress)
    Dim dlCell As Range
    Set dlCell = dfCell.Resize(dws.Rows.Count - dfCell.Row + 1) _
        .Find("*", , xlFormulas, , , xlPrevious)
    If dlCell Is Nothing Then
        MsgBox "No data in cell '" & dfCellAddress & "' or below.", _
            vbCritical, ProcName
        Exit Sub
    End If
    
    ' Create a reference to the workbook.
    Dim wb As Workbook: Set wb = dws.Parent
    
    ' Attempt to create a reference to the After sheet.
    Dim ash As Object
    On Error Resume Next
        Set ash = wb.Sheets(ashName)
    On Error GoTo ClearError
    If ash Is Nothing Then
        MsgBox "There is no sheet named '" & ashName & "'.", _
            vbCritical, ProcName
        Exit Sub
    End If
    
    ' Attempt to create a reference to the Source worksheet, the worksheet
    ' before the After sheet.
    Dim sws As Worksheet
    On Error Resume Next
        Set sws = wb.Sheets(ashName).Previous
    On Error GoTo ClearError
    If sws Is Nothing Then
        MsgBox "There is no worksheet before sheet '" & ashName & "'.", _
            vbCritical, ProcName
        Exit Sub
    End If
    
    ' Check if the Source worksheet's name begins with the Base name.
    Dim swsName As String: swsName = sws.Name
    If InStr(1, swsName, swsBaseName, vbTextCompare) <> 1 Then
        MsgBox "The worksheet name doesn't start with '" & swsBaseName & "'.", _
            vbCritical, ProcName
        Exit Sub
    End If
    
    ' Check if there is a formula containing the Base name
    ' in the first Destination cell.
    Dim dFormula As Variant
    Dim dPos As String
    dFormula = CStr(dfCell.Formula)
    dPos = InStr(1, dFormula, swsBaseName, vbTextCompare)
    If dPos = 0 Then
        MsgBox "The Base name '" & swsBaseName & "' was not found in cell '" _
            & dfCellAddress & "'.", vbCritical, ProcName
        Exit Sub
    End If
    
    ' Check if the formula is referencing ('!') the Base name.
    dFormula = Right(dFormula, Len(dFormula) - dPos + 1)
    dPos = InStr(dFormula, "!")
    If dPos = 0 Then
        MsgBox "The cell '" & dfCellAddress _
            & "' doesn't contain a worksheet reference.", vbCritical, ProcName
        Exit Sub
    End If
    
    ' Determine the New name (closing parentheses: ')').
    dFormula = Left(dFormula, dPos - 1)
    dPos = InStr(dFormula, ")")
    Dim NewName As String
    If dPos = 0 Then
        NewName = swsBaseName
    Else
        NewName = Left(dFormula, dPos)
    End If
    
    ' Check if the New name is different than the Source worksheet name.
    If StrComp(NewName, swsName, vbTextCompare) = 0 Then
        MsgBox "The formulas already contain " _
            & "the correct worksheet references.", vbExclamation, ProcName
        Exit Sub
    End If
    
    ' Account for the single quote issues (').
    If StrComp(swsName, swsBaseName, vbTextCompare) <> 0 Then
        swsName = "'" & swsName & "'"
    End If
    If NewName <> swsBaseName Then
        NewName = "'" & NewName & "'"
    End If

    ' Replace the worksheet references in the Destination column range.
    
    Dim dcrg As Range: Set dcrg = dws.Range(dfCell, dlCell)
    
    ' This should work in many cases...
    dFormula = Replace(dfCell.Formula, NewName, swsName, , , vbTextCompare)
    dcrg.Formula = dFormula '  mimics write first cell and copy down
    
'    ' ... if it doesn't, use the fast array loop version...
'    Dim drCount As Long: drCount = dcrg.Rows.Count
'    Dim dData As Variant
'    If drCount = 1 Then
'        ReDim dData(1 To 1, 1 To 1): dData(1, 1) = dcrg.Value
'    Else
'        dData = dcrg.Formula
'    End If
'    Dim r As Long
'    For r = 1 To drCount
'        dData(r, 1) = Replace(dData(r, 1), NewName, swsName, , , vbTextCompare)
'    Next r
'    dcrg.Formula = dData
    
'    ' ... or use the slow range loop version:
'    Dim dCell As Range
'    For Each dCell In dcrg.Cells
'        dFormula = Replace(dCell.Formula, NewName, swsName, , , vbTextCompare)
'        dCell.Formula = dFormula
'    Next dCell
  
    ' Inform.
    MsgBox "The worksheet reference was changed from '" & NewName & "' to '" _
        & swsName & "'.", vbInformation, ProcName

ProcExit:
    Exit Sub
ClearError:
    Debug.Print "'" & ProcName & "' Rte '" & Err.Number & "':" & vbLf _
        & "    " & Err.Description
    Resume ProcExit
End Sub

编辑：

要使其适用于多列，您可以使用 Dim dcrg... dFormula 代替：

Dim drg As Range
Set drg = dws.Range(dfCell, dlCell).EntireRow.Columns("B:O")

Dim dcrg As Range

For Each dcrg In drg.Columns
    dFormula = Replace( _
        dcrg.Cells(1).Formula, NewName, swsName, , , vbTextCompare)
    dcrg.Formula = dFormula
Next dcrg

Answer 3

请尝试下一个方法：

Dim ws As Worksheet
Set ws = Worksheets("RG").Previous
For Each cel In rng
  cel.Formula = Replace(cel.Formula, "Inlife", "'" & ws.name & "'")
Next