Question

我有一个excel，它运行在以下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

Answer 1

试试这个

转到START并在RUN行中键入REGEDIT。

湾在注册表中导航到

HKEY_CURRENT_USER \ Software \ Microsoft \ Windows \ CurrentVersion \ Internet Settings

℃。右键单击“Internet设置”，然后单击“新建”＆gt; DWORD值（32位）并将新值命名为“BypassSSLNoCacheCheck”，不带引号。双击此值并将其值设为1.

Answer 2

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：使用ActiveSheet.QueryTables.Add（Connection：=＆＃34; URL;＆＃34;＆amp; qurl，Destination：= DataSheet.Range（＆＃34; C7＆＃34;）） .BackgroundQuery = True .TablesOnlyFromHTML = False .REFRESH BackgroundQuery：= False .SaveData = True 结束退出子范围（＆＃34; C7＆＃34;）。CurrentRegion.TextToColumns目的地：=范围（＆＃34; C7＆＃34;），DataType：= xlDelimited，_ TextQualifier：= xlDoubleQuote，ConsecutiveDelimiter：= False，Tab：= 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

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：＆＃39; RetrievalProblem：＆＃39; MsgBox＆＃34;无法更新图表比例。＆＃34;，vbCritical + vbOKOnly，＆＃34;缩放错误＆＃34; 结束子

Sub Clear（）＆＃39; ＆＃39;清除宏＆＃39; 2006年3月13日由Ponzo录制的宏＆＃39;

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

End Sub

子颜色（）＆＃39; ＆＃39;颜色宏＆＃39; 2006年3月13日由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（）＆＃39; ＆＃39;刷新宏＆＃39;

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

End Sub

excel上的VBA给出了错误

2 个答案: