0
次のVBAコードで実行されるExcelがあります。先月まで完全に動作していましたが、現在はエラーが発生しています。ただ、STARTとRUNラインregeditと入力して、このVBAでエラーが発生する
移動してみてください問題
Sub SaveData()
Dim i As Integer
Clear
Range("A1").Select
For i = 1 To 1
'Range("B4") = Cells(6 + i, 14)
Range("F3") = "getting " & Range("B4")
GetData
Range("C7:Y95").Select
Selection.Copy
Sheets("FEED").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet2").Select
Columns("Z:AV").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Sheets("Sheet2").Visible = False
Sheets("FEED").Visible = False
Sheets("MAIN").Select
Range("AA2").Select
ActiveWorkbook.Connections("Connection").Delete
ActiveWorkbook.Connections("Connection1").Delete
' ActiveWorkbook.Connections("Connection2").Delete
' ActiveWorkbook.Connections("Connection3").Delete
Exit Sub
Range("I8:I300").Select
Selection.Copy
Cells(8, 14 + i).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
Next i
Range("F3") = ""
Range("BF1").Select
UpdateScale
Colour
Range("AY5").Select
End Sub
Sub GetData()
Dim QuerySheet As Worksheet
Dim DataSheet As Worksheet
Dim EndDate As Date
Dim StartDate As Date
Dim Symbol As String
Dim qurl As String
Dim nQuery As Name
Application.DisplayAlerts = False
Set DataSheet = ActiveSheet
StartDate = DataSheet.Range("B2").Value
EndDate = DataSheet.Range("B3").Value
Symbol = DataSheet.Range("B4").Value
Range("C7").CurrentRegion.ClearContents
qurl="http://www.nseindia.com/live_market/dynaContent/live_watch/option_chain/optionKeys.jsp?symbolCode=1309&symbol=" & Symbol
qurl = qurl & "&symbol=" & Symbol & "&instrument=-&date=-&segmentLink=17&symbolCount=2&segmentLink=17"
Range("b5") = qurl
QueryQuote:
With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("C7"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.REFRESH BackgroundQuery:=False
.SaveData = True
End With
Exit Sub
Range("C7").CurrentRegion.TextToColumns Destination:=Range("C7"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, other:=False
Range(Range("C7"), Range("C7").End(xlDown)).NumberFormat = "mmm d/yy"
Range(Range("D7"), Range("G7").End(xlDown)).NumberFormat = "0.00"
Range(Range("H7"), Range("H7").End(xlDown)).NumberFormat = "0,000"
Range(Range("I7"), Range("I7").End(xlDown)).NumberFormat = "0.00"
With ThisWorkbook
For Each nQuery In Names
If IsNumeric(Right(nQuery.Name, 1)) Then
nQuery.Delete
End If
Next nQuery
End With
'turn calculation back on
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Range("C7:I2000").Select
Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("C1").Select
Selection.ColumnWidth = 12
' UpdateScale
Range("B4").Select
End Sub
Sub UpdateScale()
Dim ChartVar As Chart
Dim lMax As Long, lMin As Long
On Error GoTo ScalingProblem
'Assigns the values in the Min and Max ranges to variables.
With Sheet1
lMax = .Range("Max").Value
lMin = .Range("Min").Value
'Creates chart object.
Set ChartVar = .ChartObjects("Chart 49").Chart
With ChartVar.Axes(xlValue, xlPrimary) 'Adjusts the price axis
.MinimumScale = lMin
.MaximumScale = lMax
End With
End With
Exit Sub
ScalingProblem:
'RetrievalProblem:
' MsgBox "Unable to update chart scale.", vbCritical + vbOKOnly, "Scaling Error"
End Sub
Sub Clear()
'
' Clear Macro
' Macro recorded 3/13/2006 by Ponzo
'
'
ActiveWindow.SmallScroll ToRight:=6
Range("O8:X258").Select
Selection.ClearContents
End Sub
Sub Colour()
'
' Colour Macro
' Macro recorded 3/13/2006 by Ponzo
Dim i As Integer, j As Integer, A As Double, B As Double, C As Double
A = Range("AZ2")
'B = Range("BA2")
C = Range("BB2")
For i = 1 To 10
For j = 1 To 10
If Cells(7 + i, 48 + j) < A Then
Range("AZ3").Select
Selection.Copy
Cells(7 + i, 48 + j).Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
If (Cells(7 + i, 48 + j) >= A And Cells(7 + i, 48 + j) <= C) Then
Range("BA3").Select
Selection.Copy
Cells(7 + i, 48 + j).Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(7 + i, 48 + j) > C Then
Range("BB3").Select
Selection.Copy
Cells(7 + i, 48 + j).Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
Next j
Next i
For i = 1 To 10
' Cells(7 + i, 48 + i) = ""
Cells(7 + i, 48 + i).Select
With Selection.Interior
.ColorIndex = 16
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Next i
For i = 1 To 10
For j = 1 To 10
If Cells(20 + i, 48 + j) < A Then
Range("AZ3").Select
Selection.Copy
Cells(20 + i, 48 + j).Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
If (Cells(20 + i, 48 + j) >= A And Cells(20 + i, 48 + j) <= C) Then
Range("BA3").Select
Selection.Copy
Cells(20 + i, 48 + j).Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(20 + i, 48 + j) > C Then
Range("BB3").Select
Selection.Copy
Cells(20 + i, 48 + j).Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
Next j
Next i
For i = 1 To 10
' Cells(20 + i, 48 + i) = ""
Cells(20 + i, 48 + i).Select
With Selection.Interior
.ColorIndex = 16
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Next i
Range("AY5").Select
End Sub
Sub REFRESH()
'
' REFRESH Macro
'
'
'Sheets("MAIN").Select
Sheets("Sheet2").Visible = True
'Sheets("MAIN").Select
Sheets("FEED").Visible = True
Sheets("Sheet2").Select
SaveData
End Sub
どのようなエラーをリフレッシュ？どの行？ –
http://www.nseindia.com/live_market/dynaContent/live_watch/optionを開くことはできず、デバッグ時には、.REFRESH BackgroundQuery：= False –
多くの「選択」または「選択」があります。あなたのコードでは、それは良い習慣ではなく、ほとんどの場合避けることができます。 [ここ]（http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros） –