Excel VBA-遍歷工作簿並用每個工作表的名稱標記單元格

Question

我正在嘗試編寫代碼，在其中單擊活動工作表上的一個單元格，它會循環遍歷其余工作表並用每個工作表的選項卡名稱標記該單元格。

以下代碼在以下情況下可以正常工作：

For Each Ws In Worksheets
        wb.Worksheets(1).Range("A1").FormulaR1C1 = ActiveSheet.Name
Next

但是，一旦我調用輸入框變量，代碼就會出錯。 我應該如何在此代碼中正確實現輸入框？

Public Sub FastWB(Optional ByVal opt As Boolean = True)
    With Application
        .Calculation = IIf(opt, xlCalculationManual, xlCalculationAutomatic)
        .DisplayAlerts = Not opt
        .DisplayStatusBar = Not opt
        .EnableAnimations = Not opt
        .EnableEvents = Not opt
        .ScreenUpdating = Not opt
    End With
    FastWS , opt
End Sub

Public Sub FastWS(Optional ByVal Ws As Worksheet = Nothing, _
                  Optional ByVal opt As Boolean = True)
    If Ws Is Nothing Then
        For Each Ws In Application.ActiveWorkbook.Sheets
            EnableWS Ws, opt
        Next
    Else
        EnableWS Ws, opt
    End If
End Sub

Private Sub EnableWS(ByVal Ws As Worksheet, ByVal opt As Boolean)
    With Ws
        .DisplayPageBreaks = False
        .EnableCalculation = Not opt
        .EnableFormatConditionsCalculation = Not opt
        .EnablePivotTable = Not opt
    End With
End Sub

Sub SheetLabel()

Dim Ws As Worksheet
Dim wb As Workbook
Dim t As Double
Dim cellVal As Range
Set wb = Application.ActiveWorkbook

'Optimize Macro Speed
FastWB True: t = Timer


Set cellVal = Application.InputBox("Click cell to add label to", Type:=8)


For Each Ws In Worksheets
        wb.Worksheets(1).Range("cellVal").FormulaR1C1 = ActiveSheet.Name
Next

FastWB False: MsgBox CStr(Round(Timer - t, 2)) & "s" 'Display duration of task

End Sub

Answer 1

嘗試這個

Sub SheetLabel()
    Dim Ws As Worksheet
    Dim SelectedCell As Range

    Set SelectedCell = Application.InputBox("Click cell to add label to", Type:=8)
    For Each Ws In Worksheets
        Ws.Range(SelectedCell.Address).Value = Ws.Name
    Next
End Sub

Answer 2

編輯：經過一番否決之后，我意識到OP想要做什么，並相應地編輯了答案...

Dim cellAddress As String
cellAddress = Application.InputBox("Click cell to add label to", Type:=8).Address

For Each Ws In Worksheets
    ws.Range(cellAddress).FormulaR1C1 = ws.Name
Next

或者，如果您要檢查任何無效的用戶輸入范圍：

Dim cellVal As Range
Set cellVal = Application.InputBox("Click cell to add label to", Type:=8)

If Not cellVall Is Nothing Then
    Dim cellAddress As String
    cellAddress = cellVal.Address
    For Each Ws In Worksheets
        ws.Range(cellAddress).FormulaR1C1 = ws.Name
    Next
End If