您的位置: 首页  >  技术问答  >  VBA Excel的给错误

VBA Excel的给错误

分类: 技术问答 • 2022-05-11 17:47:36
问题描述：

我有它运行在下面的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
+6

什么错误？在哪一行？ –

+0

它说无法打开http://www.nseindia.com/live_market/dynaContent/live_watch/option和调试它给出的行。REFRESH BackgroundQuery：= False –

+1

有很多'选择'或'选择'在你的代码中，这不是一个好习惯，几乎总是可以避免的。见[这里]（http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros） –

答

只是尝试这种

去开始，并在运行行键入REGEDIT。

b。在注册表定位到

HKEY_CURRENT_USER \软件\微软\的Windows \ CurrentVersion \ Internet设置

℃。右键单击Internet Settings并左键单击New> DWORD Value（32位），并将新值“BypassSSLNoCacheCheck”命名为不带引号。双击 此值，并给它1

答

子保存数据（）

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

末次值

子的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： 随着ActiveSheet .QueryTables.Add（连接：= “URL;” & qurl，目的地：= DataSheet.Range（ “C7”）） .Bac kgroundQuery =真 .TablesOnlyFromHTML =假 .REFRESH BackgroundQuery：=假 .SaveData =真 结束随着 退出小组 范围（ “C7”）CurrentRegion.TextToColumns目的地：=范围（ “C7”），数据类型：= xlDelimited，_ TEXTQUALIFIER：= xlDoubleQuote，ConsecutiveDelimiter：=假，标签：= True时，_ 分号：=假，逗号：= True时，空间：=假，其他：=假

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

结束子

子UpdateScale（） 昏暗ChartVar作为图表 昏暗LMAX只要，LMIN只要

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“无法更新图表刻度。”，vbCritical + vbOKOnly， “缩放错误” 结束子

子清除（） ' ' 清除宏 '宏记录2006年3月13日由蓬佐 '

' 
ActiveWindow.SmallScroll ToRight:=6 
Range("O8:X258").Select 
Selection.ClearContents

结束子

子滤色（） ' ' 颜色宏 '宏由蓬佐

记录2006年3月13日 
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

末次

副刷新（） ' ' 刷新宏 '

' 
'Sheets("MAIN").Select 
Sheets("Sheet2").Visible = True 
'Sheets("MAIN").Select 
Sheets("FEED").Visible = True 
Sheets("Sheet2").Select 
SaveData

末次

相关推荐