Question

我在表格中有1000行并且有这个宏：

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

这是经过测试的。谢谢你

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

这是未经测试的：

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

重复Excel宏命令1000行

2 个答案: