重复Excelmacros命令1000行

我在表中有1000行，并有这个macros：

Sub ares() Application.ScreenUpdating = False 'potlačí obnovování obrazovky Application.DisplayAlerts = False 'potlačí varovné hlášky Sheets.Add(After:=Sheets(Sheets.Count)).Name = "ares" Sheets("ares").Activate 'přesun na tento nový list 'XML dotaz do ARESU s tím, že ičo máme na první listu v buňce C2 a importovná data chceme vložit do buňky A1 ActiveWorkbook.XmlImport URL:="http://wwwinfo.mfcr.cz/cgi-bin/ares/darv_std.cgi?obchodni_firma=" & Sheets(1).Range("C2").Value, ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$A$1") Sheets(1).Activate Sheets(1).Range("A2") = Sheets("ares").Range("AK3") Sheets("ares").Delete 'smazání pomocného listu Application.ScreenUpdating = True 'zapne obnovování obrazovky Application.DisplayAlerts = FaTruelse 'obnoví varovné hlášky End Sub 

我想在1000行的范围内重复这个任务，而不是上面显示的内容。

Answer 1

这是testing。 谢谢你

 Sub ares() For i = 14 To 17 Application.ScreenUpdating = False 'potlací obnovování obrazovky Application.DisplayAlerts = False 'potlací varovné hlášky Sheets.Add(After:=Sheets(Sheets.Count)).Name = "ares" Sheets("ares").Activate 'presun na tento nový list ActiveWorkbook.XmlImport URL:="http://wwwinfo.mfcr.cz/cgi-bin/ares/darv_std.cgi?obchodni_firma=" & Sheets(1).Range("C" & i).Value, ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$A$1") Sheets(1).Range("D" & i) = Sheets("ares").Range("AK3") Cells.Select Selection.ClearContents Range("A1").Select Sheets("ares").Delete 'smazání pomocného listu Application.ScreenUpdating = True 'zapne obnovování obrazovky Application.DisplayAlerts = True 'obnoví varovné hlášky Next i End Sub 

Answer 2

这是未经testing的：

 Sub ares() Application.ScreenUpdating = False 'potlací obnovování obrazovky Application.DisplayAlerts = False 'potlací varovné hlášky Sheets.Add(After:=Sheets(Sheets.Count)).Name = "ares" Sheets("ares").Activate 'presun na tento nový list For i = 2 To 1002 ActiveWorkbook.XmlImport URL:="http://wwwinfo.mfcr.cz/cgi-bin/ares/darv_std.cgi?obchodni_firma=" & Sheets(1).Range("C " & i).Value, ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$A$1") Sheets(1).Range("A" & i) = Sheets("ares").Range("AK3") Cells.Select Selection.ClearContents Range("A1").Select Next i Sheets("ares").Delete 'smazání pomocného listu Application.ScreenUpdating = True 'zapne obnovování obrazovky Application.DisplayAlerts = True 'obnoví varovné hlášky End Sub