Excel VBA - 遍历工作簿并使用每个工作表的名称标记单元格

时间:2018-02-18 21:41:31

标签: excel vba excel-vba

我尝试编写代码,单击活动工作表上的一个单元格,然后循环显示其余工作表,并用每个工作表的选项卡名称标记该单元格。

如果符合以下条件,则以下代码可以正常工作:

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

但是只要我调用输入框变量,代码就会出错。我该如何在这段代码中正确实现输入框?

{{1}}

2 个答案:

答案 0 :(得分:2)

试试这个

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

答案 1 :(得分:0)

编辑:在一些downvotes之后,我意识到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