Question

我有一个当前工作原理的宏，但我想使用计数器循环遍历每个工作表并执行宏与使用激活命令b / c我的宏引用ActiveSheet。

我已经尝试过多次更改，但每次都没有递增到下一张表，最终会出现问题。任何帮助将不胜感激。

Sub Set_Data()

Dim lngCount As Long
Dim nLastCol, i, j As Integer

'Capture Required Inputs
sTerm = InputBox("Enter Term ID")
sProduct = InputBox("Enter Product ID")
sState = InputBox("Enter 2-Letter State Abbreviation")

For j = 1 To ActiveWorkbook.Worksheets.Count
Set ws = Worksheets(j)
ws.Activate

'DO NOT RUN IF ALREADY RUN
If ActiveSheet.Range("A1") <> "Issue Age" Then
   MsgBox "This Workbook Has Already Been Updated"
Exit Sub
End If

lngCount = Application.WorksheetFunction.CountA(Columns(2))
'Rename Issue Age Column Header

Range("A1").Select
ActiveCell.FormulaR1C1 = "Age"

'Insert Term Column
Columns("A:A").Insert Shift:=xlToRight
Range("A1:A" & lngCount).FormulaR1C1 = sTerm

Range("A1").Select
ActiveCell.FormulaR1C1 = "termid"

'Insert  Product Column
Columns("A:A").Insert Shift:=xlToRight
Range("A1:A" & lngCount).FormulaR1C1 = sProduct

    Range("A1").Select
    ActiveCell.FormulaR1C1 = "productid"


    'Insert  State Column
    Columns("A:A").Insert Shift:=xlToRight
Range("A1:A" & lngCount).FormulaR1C1 = sState
Range("A1").Select
ActiveCell.FormulaR1C1 = "State"


'Delete Issue Age Column

'This next variable will get the column number of the very last column that has data in it, so we can use it in a loop later
nLastCol = ActiveSheet.Cells.Find("*", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

'This loop will go through each column header and delete the column if the header contains "Issue Age"

For i = nLastCol To 1 Step -1
    If InStr(1, ActiveSheet.Cells(1, i).Value, "Issue Age", vbTextCompare) > 0 Then
        ActiveSheet.Columns(i).Delete Shift:=xlShiftToLeft
    End If
Next i

'Delete Empty Column

i = ActiveSheet.Cells.SpecialCells(xlLastCell).Column
Do Until i = 0

If WorksheetFunction.CountA(Columns(i)) = 0 Then
Columns(i).Delete
End If

i = i - 1

Loop

'Rename Tabs
If InStr((ActiveSheet.Name), ("25,000")) Then
    ActiveSheet.Name = "A25"
End If
If InStr((ActiveSheet.Name), ("100,000")) Then
    ActiveSheet.Name = "A100"
End If

If InStr((ActiveSheet.Name), ("250,000")) Then
    ActiveSheet.Name = "A250"
End If
If InStr((ActiveSheet.Name), ("500,000")) Then
    ActiveSheet.Name = "A500"
End If

Next j

End Sub

Answer 1

试试这个，还没有测试过。

Sub Set_Data()
Dim ws As Worksheet
Dim lngCount As Long
Dim nLastCol, i, j As Integer

'Capture Required Inputs
sTerm = InputBox("Enter Term ID")
sProduct = InputBox("Enter Product ID")
sState = InputBox("Enter 2-Letter State Abbreviation")

For Each ws In Worksheets
With ws
'DO NOT RUN IF ALREADY RUN
If .Range("A1").Value <> "Issue Age" Then
   MsgBox "This Workbook Has Already Been Updated"
Exit Sub
End If

lngCount = Application.WorksheetFunction.CountA(.Columns(2))
'Rename Issue Age Column Header

.Range("A1").Value = "Age"

'Insert Term Column
.Columns("A:A").Insert Shift:=xlToRight
.Range("A1:A" & lngCount).Value = sTerm

.Range("A1").Value = "termid"

'Insert  Product Column
.Columns("A:A").Insert Shift:=xlToRight
.Range("A1:A" & lngCount).Value = sProduct

    .Range("A1").Value = "productid"


    'Insert  State Column
    .Columns("A:A").Insert Shift:=xlToRight
.Range("A1:A" & lngCount).Value = sState
.Range("A1").Value = "State"


'Delete Issue Age Column

'This next variable will get the column number of the very last column that has data in it, so we can use it in a loop later
nLastCol = .Cells.Find("*", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

'This loop will go through each column header and delete the column if the header contains "Issue Age"

For i = nLastCol To 1 Step -1
    If InStr(1, .Cells(1, i).Value, "Issue Age", vbTextCompare) > 0 Then
        .Columns(i).Delete Shift:=xlShiftToLeft
    End If
Next i

'Delete Empty Column

i = .Cells.SpecialCells(xlLastCell).Column
Do Until i = 0

If WorksheetFunction.CountA(.Columns(i)) = 0 Then
.Columns(i).Delete
End If

i = i - 1

Loop
'Rename Tabs
If InStr((.Name), ("25,000")) Then
    .Name = "A25"
End If
If InStr((.Name), ("100,000")) Then
    .Name = "A100"
End If

If InStr((.Name), ("250,000")) Then
    .Name = "A250"
End If
If InStr((.Name), ("500,000")) Then
    .Name = "A500"
End If

End With
Next ws

End Sub

正如您所说，尽量避免使用.Select，this也可以帮助您。如果要更改单元格的内容而不插入实际的公式使用.Value。

更新宏以循环遍历所有工作表并执行

1 个答案: