在多張紙上重複相同的計算

任務：在多張紙上重複相同的計算。在多張紙上重複相同的計算

背景：

由日曆日期標記的多張紙即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

來源

2013-12-13 user3047291

你想在哪裏複製col G的值？ Col E？ –

宏是否能夠在所有工作表上工作而無需更改？如果是這樣，創建一個新的子過程，循環遍歷所有工作表並調用上述宏 – Sorceri

在你想，因爲你正在使用活動單元格，你可以用這樣的替換活動單元格的牀單這不會重複：

sheetname.cells(1,1).value

在這種情況下，您正在創建單元格A1的值，這是名爲sheetname的工作表中的行= 1，列= 1

您的工作表的名稱並非必須與vba相同，因此您的vba中的narme項目瀏覽器。

例如，你可以嘗試這樣的事情（林不知道正是你正在嘗試做的，但是這將引導你）：

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

來源

2013-12-13 16:28:45

[有趣的閱讀]（http://stackoverflow.com/questions/10714251/excel-macro-avoiding-using-select） –

避免選擇檢查@ SiddharthRout reading –

user2864030：感謝您的建議和鏈接到MS站點。非常有用和有效。現在試圖瞭解它是如何工作的。但是，目前它執行所需的操作。（但是我必須繼續按下對話框中的「ok」，直到它完成所有工作表（30次點擊））但是它肯定比以前更快。非常感謝你 – user3047291

否則：

 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

來源

2013-12-13 16:58:23 user2864030

在多張紙上重複相同的計算

回答

相關問題