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

我使用的 Excel 作業表應該參考 Inlife (n) 系列中的最新作業表，我得到了 VBA，以便在我手動告訴它要使用哪個作業表時替換參考。我不能簡單地使用最后一張紙或所有床單中的第 5 張或其他東西。但是，位置始終是作業表 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

這根本行不通，但我希望你理解我的意圖。（我確定這看起來很荒謬，但我不知道如何描述我的問題）

我希望你能幫幫我

uj5u.com熱心網友回復：

您可以按順序遍歷作業表，將最新的作業表分配給名稱以“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).

uj5u.com熱心網友回復：

請嘗試下一個方法：

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

uj5u.com熱心網友回復：

更新公式作業表參考

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

標籤：擅长 vba

上一篇：Excelvba宏字串和日期

下一篇：文本到列VBA