0
我有它運行在下面的VBA代碼的Excel。直到上個月它工作完美，但現在給錯誤。請幫忙排序問題VBA Excel的給錯誤
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） –