[英]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.