简体   繁体   English

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

[英]Excel VBA - Loop through workbook and label a cell with each sheet's name

I'm trying to write code where you click one cell on the active sheet and it loops through the rest of the sheets and labels that cell with each sheet's tab name. 我正在尝试编写代码,在其中单击活动工作表上的一个单元格,它会循环遍历其余工作表并用每个工作表的选项卡名称标记该单元格。

The code below works fine if: 以下代码在以下情况下可以正常工作:

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

but as soon as I call the input box variable, the code errors out. 但是,一旦我调用输入框变量,代码就会出错。 How should I correctly implement the input box into this code? 我应该如何在此代码中正确实现输入框?

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

Try this 尝试这个

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

Edit: after some downvotes, I realized what the OP wanted to do and edited answer accordingly... 编辑:经过一番否决之后,我意识到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

or, if you want to check for any invalid user input range: 或者,如果您要检查任何无效的用户输入范围:

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

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

相关问题 For 在工作簿中循环工作表 – 工作表名称等于单元格范围 - Excel VBA - For Loop through sheets in a workbook – sheet names equal to a cell range - Excel VBA 使用VBA遍历每个Excel工作表 - Loop through each excel sheet using vba 从列中选择每个单元格,并在另一个工作簿中的列中循环(如果存在)Excel VBA宏 - select each cell from a column and loop through a column in another workbook if it exists Excel VBA Macro Excel VBA - 遍历一列单元格并搜索工作簿中的每个单元格值 - Excel VBA - Loop through a column of cells and search for each cell value in the workbook 如何遍历每个Excel工作表名称 - how to loop through each excel sheet name 如何遍历目录并导出Excel文件,工作簿,工作表和工作表(VBA宏)? - How to loop through directory and export content of excel files, workbook by workbook, sheet by sheet (VBA Macros)? 遍历每个工作簿VBA中的工作簿和工作表 - Loop through workbook and sheets in each workbook vba 在工作簿中的每个工作表上重复Excel VBA代码 - Repeat Excel VBA code on Each Sheet in Workbook 使用VBA在Excel工作簿的第二张工作表上运行循环 - Running loop on second sheet in Excel Workbook with VBA 使用单元格引用作为工作簿和工作表的名称来激活Excel工作簿/工作表 - Activating Excel Workbook/Sheet using cell reference as name of Workbook and Worksheet
 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM