为vba使用for循环

时间:2015-01-19 07:48:15

标签: vba excel-vba excel

在循环中运行以下代码35次,并且...也用增量值替换file1,并将Rannge(“D6”)增加为范围(“D7”),依此类推。

使用for循环并迭代35次递增file1和d6 cell

Windows(File1).Activate

Range("A1").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, -2).Range("A1:B1").Select
ActiveCell.Columns("A:B").EntireColumn.Select
ActiveCell.Offset(27961, 0).Range("A1").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "Result"
ActiveSheet.Paste
Range("C1").Value = "Year"
Range("C2").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-2],4)"
Selection.AutoFill Destination:=Range("C2:C" & Range("B1048576").End(xlUp).Row)


Dim year As Integer
year = InputBox("Fill in year")
Dim week As Integer
week = InputBox("Fill in week")

Cells(1, 4) = "YEAR"
Range("C2:C" & Range("C1048576").End(xlUp).Row).Select
Selection.Copy
Range("D2").Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False

Cells(1, 5) = "Values"
Cells(2, 5).Select
ActiveCell.FormulaR1C1 = "=IF(AND(RC[-1]=" & year & ",RC[-3]=" & week & "),1,0)"
Selection.AutoFill Destination:=Range("E2:E" & Range("D1048576").End(xlUp).Row)

  Range("D:D").Select

With Selection
Selection.NumberFormat = "0"
.Value = .Value
 End With

Range("F2").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-1]:R[98576]C[-1])"
ActiveCell.Select

Cells(2, 6).Select
Selection.Copy
Windows("Penetrace Macros.xlsm").Activate
Sheets("Book1withCount").Activate
Range("D6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
ActiveCell.Offset(1, 0).Select
Windows("Penetrace Macros.xlsm").Activate
Application.DisplayAlerts = False
Windows(File1).Activate
Sheets("Result").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Workbooks(File1).Close SaveChanges:=False
Windows("Penetrace Macros.xlsm").Activate
Range("A1").Select

1 个答案:

答案 0 :(得分:0)

你可以试试这个吗?想法会是这样的。

Dim FileNo As String

For i = 1 To 35
FileNo = "File" & i
Windows(FileNo).Activate

'Rest of the code
Next