Attribute VB_Name = "Module1" Sub make_webquery() : ana" ' ' make_webquery Macro ' マクロ記録日 : 2003/10/12 ユーザー名 : ana ' '警告の表示を停止 Application.DisplayAlerts = False ' With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;C:\Documents and Settings\穴原 忠度\My Documents\25webquery\iqy_summary\corp_grp_list.txt" _ , Destination:=Range("A1")) ' .Name = "industrial_classification" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = xlWindows .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1) .Refresh BackgroundQuery:=False End With Dim sheetname02 As Variant sheetname02 = Array("forestry_fishery", "mining", _ "builiding1", "builiding2", "builiding3", "builiding4", "builiding5", _ "food1", "food2", "food3", "food4", _ "fiber1", "fiber2", "paper_pulp", _ "chemical1", "chemical2", "chemical3", "chemical4", "chemical5", _ "medicine", "petroleum_coal", "rubber", _ "glass_stone1", "glass_stone2", _ "iron1", "iron2", "metal_exiron", _ "metal1", "metal2", _ "machinery1", "machinery2", "machinery3", "machinery4", "machinery5", _ "electrical1", "electrical2", "electrical3", "electrical4", "electrical5", "electrical6", "electrical7", _ "transport_machinery1", "transport_machinery2", "transport_machinery3", "precision_machinery", _ "misc_machinery1", "misc_machinery2", "misc_machinery3", "electrocity_gas", _ "land_transport1", "land_transport2", _ "shipping", "sky_transport", "warehouse_conveyance", _ "communication1", "communication2", "communication3", "communication4", "communication5", "communication6", _ "wholesale1", "wholesale2", "wholesale3", "wholesale4", "wholesale5", "wholesale6", "wholesale7", "wholesale8", _ "retail1", "retail2", "retail3", "retail4", "retail5", "retail6", "retail7", _ "bank1", "bank2", "bank3", _ "bill_broaker", "insurer", _ "financial1", "financial2", _ "estate1", "estate2", _ "service1", "service2", "service3", "service4", "service5", "service6") 'Sheet(x)に対してsheetname02(x-2)を当てはめる Sheets("Sheet2").Select Sheets("Sheet2").Name = sheetname02(0) Sheets("Sheet3").Select Sheets("Sheet3").Name = sheetname02(1) Dim ix As Integer For ix = 4 To 91 ' 作成するワークシート数を指定する Sheets.Add sheetname = "Sheet" & ix Sheets(sheetname).Select Sheets(sheetname).Name = sheetname02(ix - 2) 'If sheetname02(ix) = Null Then ' Exit For 'End If Next For ix = 0 To 89 Sheets("Sheet1").Select Cells.Find(What:="http", After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ False).Activate Selection.Cut 'Sheets("Sheet1").Select 'Cells.FindNext(After:=ActiveCell).Activate 'Selection.Cut Sheets(sheetname02(ix)).Select Range("A3").Select ActiveSheet.Paste Range("A1").Select ActiveCell.FormulaR1C1 = "WEB" Range("A2").Select ActiveCell.FormulaR1C1 = "1" Sheets(sheetname02(ix)).Select ChDir "C:\Documents and Settings\穴原 忠度\My Documents\25webquery\iqy_summary" ActiveWorkbook.SaveAs Filename:= _ "C:\Documents and Settings\穴原 忠度\My Documents\25webquery\iqy_summary\" _ & sheetname02(ix) & ".iqy", FileFormat:=xlText, CreateBackup:=False 'Worksheets(sheetname02(ix)).Delete Next End Sub