excel - VBA代码用另一张纸上的单元格值替换公式的一部分

Question

我编写了一个 VBA 代码，每次将新工作表添加到工作簿时都会运行，但我遇到了障碍。这是我目前所拥有的......

工作表 1 (Job2Date) 是后面所有工作表的摘要。该模板已显示第 (1) 周。添加的每张工作表都会更改工作表名称（第（2）周、第（3）周、第（4）周等）的数字。有一个隐藏的工作表是所有复制和粘贴的新工作表的模板到新工作表。然后出现一个弹出窗口并询问该周的第一天是什么并填写适当的部分。在单元格“A442”中粘贴工作表名称。在主工作表 (Job2Date) 上，它将新的周总列添加到第一个空列并填写正确的日期和周名称。

现在我坚持的部分是我需要用新的工作表名称替换新部分中的所有公式。

公式：=IF(Week!$G6="","",Week!$G6)

我有这个第一次工作的代码，但工作表名称总是在变化。我需要它来代替“周！” 无论新工作表名称（新工作表的“A442”）是什么，我都需要它来替换刚刚添加的 4 列。

Sub Replace()
    
        Sheets("Job2Date").Select
        Range("W12:Z701").Select
        Sheets("Week (2)").Select
        Range("A442").Select
        Selection.Copy
        Sheets("Job2Date").Select
        Selection.Replace What:="Week!", Replacement:="'Week (2)'!", LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False, FormulaVersion:=xlReplaceFor`enter code here`mula2
End Sub

到目前为止，这是我的全部代码。

Private Sub Workbook_NewSheet(ByVal Sh As Object)

    Sheets("Job2Date").Select
    Sheets("Week").Visible = True
    Sheets("Week").Select
    Sheets("Week").Copy After:=Worksheets(Worksheets.Count)
    Sheets("Week").Select
    ActiveWindow.SelectedSheets.Visible = False
    
    Call BlankWorksheets 'This deletes any blank sheets in the workbook
        
    Sheets(Sheets.Count).Select
    
    Dim myValue As Variant
    
'Knowing the first date of the week
myValue = InputBox("What is the start date of this week?", dd, mm, yyyy)
Range("O2").Value = myValue

'Finding new tab name
ActiveSheet.[a442] = ActiveSheet.Name

'Adding a new week onto Job2Date
Select Case Sheets("Job2Date").Range("A1") = ""
Case True
Sheets("Job2Date").Range("O7:R701").Copy Sheets("Job2Date").Range("A7")
Case False
Sheets("Job2Date").Range("O7:R701").Copy Sheets("Job2Date").Range("XFD7").End(xlToLeft).Offset(0, 1)
End Select


'Name of New tab added Job2Date
ActiveSheet.Range("A442").Copy
Sheets("Job2Date").Select
Sheets("Job2Date").Range("XFD9").End(xlToLeft).Offset(, 1).PasteSpecial xlValues
Application.CutCopyMode = False


ActiveCell.Resize(1, 4).Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With

'Adding End Date to Job2Date
Call GoToLast 'This goes to the last sheet that was active
ActiveSheet.Range("AM2").Copy
Sheets("Job2Date").Select
Sheets("Job2Date").Range("XFD10").End(xlToLeft).Offset(, 1).PasteSpecial xlValues
Application.CutCopyMode = False

ActiveCell.Resize(1, 2).Merge


'Go to the Previous Sheet
Call GoToLast

Range("A1").Select

End Sub

标签： excelvbaexcel-2016find-replace

Answer 1

工作簿中缺少很多变量声明，这使其成为一个挑战，特别是因为宏变得更大更复杂。我强烈建议阅读变量声明并避免 select。

我还认为您可以跳过几个 Select 语句，如果您真的需要它们，请将它们更改为 -> Sheet("Sheet1").Select -> Sheet("Sheet1").Activate。

因此，为了保留工作表名称以便能够在“子替换”中使用它，我在主代码中添加了调用替换。

当我们创建一个新工作表时，我要做的第一件事是获取工作表名称并将其声明为一个公共变量，我们可以跨模块使用它，并在代码中引用新工作表并避免活动表行。该工作表名称随后用于替换Replacement:="'Week (2)'!"-> ThisWorkbook.new_sht_added。

我希望这会让你有一个想法和一些额外的代码行来继续（我还清理了一些代码）。我认为工作簿的布局和工作非常好，易于理解，所以继续努力吧:)！

链接到工作簿

Sub Replace()

    Dim Last_Col As Long
    Dim Last_Row As Long
    
    
    'Sheets("Job2Date").Range ("W12:Z701")
    'Sheets("Week (1)").Select
    'Range("A442").Select
    'Selection.Copy
    
    Last_Col = Sheets("Job2Date").Cells(8, Columns.Count).End(xlToLeft).Column 'define the last column for the new range
    Last_Row = Sheets("Job2Date").Cells(Rows.Count, Last_Col - 3).End(xlUp).Row 'define the last row for the new range based on the last column created from Last_Col
    Debug.Print ThisWorkbook.new_sht_added
    
    Sheets("Job2Date").Activate
    ThisWorkbook.Sheets("Job2Date").Range(Sheets("Job2Date").Cells(8, Last_Col - 3), Sheets("Job2Date").Cells(Last_Row, Last_Col)).Select
    
    'https://stackoverflow.com/questions/39402914/replace-reference-to-worksheet-in-a-formula-via-macro
    ThisWorkbook.Sheets("Job2Date").Range(Cells(11, Last_Col - 3), Cells(Last_Row, Last_Col)).Replace What:="Week", Replacement:="'" + ThisWorkbook.new_sht_added + "'", _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub

到目前为止，这是我的全部代码。

Public new_sht_added As String

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    Set LstSht = Sh
End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object)
'Sub New_sheet()

    Dim wk_name_Job2Date As Range 'Define the new week name range

    Sheets("Job2Date").Activate                                             '# Changed
    Sheets("Week").Visible = True
    'Sheets("Week").Select                                                  '# Don't think you need this
    
    'Create new worksheet and change the name
    Sheets("Week").Copy After:=Worksheets(Worksheets.Count)
    new_sht_added = ActiveSheet.Name 'We take the name of the new worksheet and store it as a public variable which we can access the new sheet name across sub
    
    'Sheets("Week").Select                                                  '# Don't think you need this
    ' ActiveWindow.SelectedSheets.Visible = False                           ' Think about to set this at a later stage in the code to not disturb or be more specific about what you want to hide, sometimes it causes error I think
    
    Call BlankWorksheets 'This deletes any blank sheets in the workbook
        
    Sheets(Sheets.Count).Select
    
    Dim myValue As Variant
    
'''Knowing the first date of the week'''
myValue = InputBox("What is the start date of this week?", dd, mm, yyyy)
Range("O2").Value = myValue

'''Finding new tab name'''
ActiveSheet.Range("A442").Value = ActiveSheet.Name                          '# Changed this, I didn't get the sheet name with previous line

'''Adding a new week onto Job2Date'''
Select Case Sheets("Job2Date").Range("A1") = ""
Case True
Sheets("Job2Date").Range("O7:R701").Copy Sheets("Job2Date").Range("A7")
Case False
Sheets("Job2Date").Range("O7:R701").Copy Sheets("Job2Date").Range("XFD7").End(xlToLeft).Offset(0, 1)
End Select


'''Name of New tab added Job2Date'''
Sheets(new_sht_added).Range("A442").Copy
Set wk_name_Job2Date = Sheets("Job2Date").Range("XFD8").End(xlToLeft).Offset(1, -3) '# Make the weekname in the sheet "Job2Date" as a range which you can use multiple of times later. I also change the offset to more reliable range

wk_name_Job2Date.PasteSpecial xlValues '# Refer to the defined range and paste as values
Application.CutCopyMode = False


wk_name_Job2Date.Resize(1, 4).Merge '# As we also want to adjust the cell we can again refer to the range
    With wk_name_Job2Date
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With

'''Adding End Date to Job2Date'''
Call GoToLast 'This goes to the last sheet that was active
Sheets(new_sht_added).Range("AM2").Copy
'Sheets("Job2Date").Select                                                          '# Don't think you need this
Sheets("Job2Date").Range("XFD10").End(xlToLeft).Offset(, 1).PasteSpecial xlValues
Application.CutCopyMode = False

ActiveCell.Resize(1, 2).Merge


'''Go to Previous Sheet'''
Call GoToLast

Range("A1").Select


'''Adjust formulas for new sheet'''
Call Replace

End Sub