Question

任务：在多张纸上重复相同的计算。

背景：

按日历日期标记的多张纸，即01 04,02 04,03 04.这是三个不连续的纸张名称，即4月1日，4月2日和4月3日。（实际工作簿中包含了该月的所有日期）。
数据具有相同的列标题，但行数不同。简而言之，数据是万事达卡和签证交易清单。
我想得到G栏的总数（恰好包含货币交易价值），只接受Visa交易。

结果：

下面的代码可以很好地将结果放在同一张纸上，只是偏向右侧的几列，并以红色突出显示我需要的值。（这是我完成的录制宏）

限制和寻求建议：

1）通过单击鼠标按钮改进代码以对所有工作表重复此操作。（正如您将注意到的，它是关于如何循环遍历同一工作簿中的所有工作表而不是（目前）必须手动进入每个工作表并运行宏。

提前谢谢

代码是：

Sub sum_visa_trans_together()
'
' sum_visa_trans_together Macro
'
' Keyboard Shortcut: Ctrl+r
'
ActiveCell.Rows("1:1").EntireRow.Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$M$14").AutoFilter Field:=2, Criteria1:="V"
ActiveCell.Offset(0, 6).Columns("A:A").EntireColumn.Select
Selection.Copy
ActiveCell.Offset(0, 4).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Rows("1:1").EntireRow.Select
Application.CutCopyMode = False
Selection.AutoFilter
ActiveCell.Offset(0, 11).Range("A1").Select
ActiveCell.FormulaR1C1 = "max"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "=MAX(C[-1])"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "=SUM(C[-1])"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "visa trans"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "=R[-2]C-R[-3]C"
ActiveCell.Select
With Selection.Font
    .Color = -16776961
    .TintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

Answer 1

这不会在您想要的工作表中重复，因为您使用的是活动单元格，您可以使用以下内容替换活动单元格：

sheetname.cells(1,1).value

在这种情况下，您要在名为sheetname的工作表

中确定单元格A1的值，其中row = 1，column = 1

你的表单的名称在vba中不是必需的，所以在vba项目资源管理器中查找你的叙述。

例如，你可以尝试这样的事情（我不确定你想要做什么，但这将指导你）：

Sub s()

For Each ws In Worksheets 'WS will loop trough all worksheets

Dim TargetCell As Range
Set TargetCell = ws.Cells(1, 2) ' in this case you will run this macro in
                            ' the cell A2 of all your sheets

TargetCell.Rows("1:1").EntireRow.Select
Selection.AutoFilter
ws.Range("$A$1:$M$14").AutoFilter Field:=2, Criteria1:="V"
TargetCell.Offset(0, 6).Columns("A:A").EntireColumn.Select
Selection.Copy
TargetCell.Offset(0, 4).Range("A1").Select
ws.Paste
TargetCell.Rows("1:1").EntireRow.Select
Application.CutCopyMode = False
Selection.AutoFilter
TargetCell.Offset(0, 11).Range("A1").Select
TargetCell.FormulaR1C1 = "max"
TargetCell.Offset(1, 0).Range("A1").Select
TargetCell.FormulaR1C1 = "=MAX(C[-1])"
TargetCell.Offset(1, 0).Range("A1").Select
TargetCell.FormulaR1C1 = "=SUM(C[-1])"
TargetCell.Offset(1, 0).Range("A1").Select
TargetCell.FormulaR1C1 = "visa trans"
TargetCell.Offset(1, 0).Range("A1").Select
TargetCell.FormulaR1C1 = "=R[-2]C-R[-3]C"
TargetCell.Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Next
End Sub

Answer 2

否则：

      Sub WorksheetLoop()

     Dim WS_Count As Integer
     Dim I As Integer

     ' Set WS_Count equal to the number of worksheets in the active
     ' workbook.
     WS_Count = ActiveWorkbook.Worksheets.Count

     ' Begin the loop.
     For I = 1 To WS_Count

        ' Insert your code here.
        ' The following line shows how to reference a sheet within
        ' the loop by displaying the worksheet name in a dialog box.
        MsgBox ActiveWorkbook.Worksheets(I).Name

     Next I

  End Sub

来源：http://support.microsoft.com/kb/142126/en

在多个工作表中重复相同的计算

2 个答案: