運行時錯誤'9'VBA子腳本超出范圍

Question

我在工作中插入了一張工作表，沒有人真正支持任何與Excel有關的東西。 我的VBA非常生銹，因此我希望有人可以在這里幫助我。

我有以下代碼： 如果mesi（mese）=“ JAN”，它會出錯， 然后anno = Int（Right（oggi，2））+ 1其他anno = Int（Right（oggi，2））我得到運行時錯誤'9'：下標超出范圍我沒有進行任何更改，並且它可以正常工作很長時間。 我真的很感謝任何投入

非常感謝

Public Function Pulsante1_Click()


Dim oggi As Date
Dim mesi(1 To 12) As String
Dim prossima_data As String
Dim squarto, sstagione As String
Dim sqa As Range
Dim valore As Double
Dim r As Integer
Dim c As Integer
Dim quarto As Integer
Dim mesi_spalm() As String
Dim valori_spalm() As Double
Dim valor() As Double



Dim anno, mese As Integer


ActiveSheet.Range("J2:K1000000").ClearContents
ActiveSheet.Range("M2:N1000000").ClearContents
ActiveSheet.Range("P2:Q1000000").ClearContents
ActiveSheet.Range("J2:K1000000").Interior.ColorIndex = xlNone
ActiveSheet.Range("M2:N1000000").Interior.ColorIndex = xlNone
ActiveSheet.Range("P1:Q1000000").Interior.ColorIndex = xlThemeColorLight2


mesi(1) = "JAN"
mesi(2) = "FEB"
mesi(3) = "MAR"
mesi(4) = "APR"
mesi(5) = "MAY"
mesi(6) = "JUN"
mesi(7) = "JUL"
mesi(8) = "AUG"
mesi(9) = "SEP"
mesi(10) = "OCT"
mesi(11) = "NOV"
mesi(12) = "DEC"


oggi = Date

mese = (Int(Mid(oggi, 4, 2)) + 1) Mod 12

If mesi(mese) = "JAN" Then anno = Int(Right(oggi, 2)) + 1 Else anno = Int(Right(oggi, 2))


prossima_data = mesi(mese) & Right(anno, 1)

'MsgBox (prossima_data)


If ActiveSheet.Cells(29, 5) = oggi Then

ActiveSheet.Cells(2, 10) = oggi + 1
ActiveSheet.Cells(2, 11) = ActiveSheet.Cells(29, 3)

i = 3
Else


i = 2
End If

If (ActiveSheet.Cells(3, 2) = prossima_data) And (ActiveSheet.Cells(3, 5) = Date) Then


ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = ActiveSheet.Cells(3, 3)

i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If


If InStr(ActiveSheet.Cells(4, 2), "#N/A") = 0 And (ActiveSheet.Cells(4, 5) = Date) Then

ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = ActiveSheet.Cells(4, 3)
i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If

End If

If InStr(ActiveSheet.Cells(5, 2), "#N/A") = 0 And (ActiveSheet.Cells(5, 5) = Date) Then

ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = ActiveSheet.Cells(5, 3)
i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If

End If

If InStr(ActiveSheet.Cells(6, 2), "#N/A") = 0 And (ActiveSheet.Cells(6, 5) = Date) Then

ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = ActiveSheet.Cells(6, 3)
i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If

End If

If InStr(ActiveSheet.Cells(7, 2), "#N/A") = 0 And (ActiveSheet.Cells(7, 5) = Date) Then

ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = ActiveSheet.Cells(7, 3)
i = i + 1

mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If

End If



ElseIf ActiveSheet.Cells(4, 2) = prossima_data And (ActiveSheet.Cells(4, 5) = Date) Then



ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = ActiveSheet.Cells(4, 3)
i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If


If InStr(ActiveSheet.Cells(5, 2), "#N/A") = 0 And (ActiveSheet.Cells(5, 5) = Date) Then

ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = ActiveSheet.Cells(5, 3)
i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If

End If

If InStr(ActiveSheet.Cells(6, 2), "#N/A") = 0 And (ActiveSheet.Cells(6, 5) = Date) Then

ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = ActiveSheet.Cells(6, 3)
i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If

End If

If InStr(ActiveSheet.Cells(7, 2), "#N/A") = 0 And (ActiveSheet.Cells(7, 5) = Date) Then

ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = ActiveSheet.Cells(7, 3)
i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If


End If




End If


'MsgBox (mese & " " & anno)



'cercare in foglio reuters il quarter e se la data è di oggi allora moltiplicare il suo valore per i pesi in valori_spalm per ottenere i singoli valori mese


quarto = WorksheetFunction.Ceiling(mese / 3, 1)
squarto = quarto & "Q" & anno

r = 1
c = 1

Set sqa = ActiveSheet.Range("B10:B16").Find(squarto, LookIn:=xlValues)
If Not sqa Is Nothing Then
    r = sqa.Row
    c = sqa.Column
End If

While Not sqa Is Nothing And ActiveSheet.Cells(r, c + 3) = Date

If Not sqa Is Nothing And ActiveSheet.Cells(sqa.Row, sqa.Column + 3) = Date Then

valore = ActiveSheet.Cells(sqa.Row, sqa.Column + 1)

ReDim mesi_spalm(1 To 3)

Select Case quarto
Case 1
    mesi_spalm(1) = mesi(1) & anno
    mesi_spalm(2) = mesi(2) & anno
    mesi_spalm(3) = mesi(3) & anno
Case 2
    mesi_spalm(1) = mesi(4) & anno
    mesi_spalm(2) = mesi(5) & anno
    mesi_spalm(3) = mesi(6) & anno
Case 3
    mesi_spalm(1) = mesi(7) & anno
    mesi_spalm(2) = mesi(8) & anno
    mesi_spalm(3) = mesi(9) & anno
Case 4
    mesi_spalm(1) = mesi(10) & anno
    mesi_spalm(2) = mesi(11) & anno
    mesi_spalm(3) = mesi(12) & anno
End Select

For j = 1 To 3
If mesi(mese) & anno = mesi_spalm(j) Then Exit For
Next j

If j > 1 Then ReDim valor(1 To (j - 1)) Else ReDim valor(0)

For pp = 1 To (j - 1)

valor(pp) = ActiveSheet.Cells(i - pp, 11)

Next pp



valori_spalm = spalma_mesi(mesi_spalm, valor, valore)


For k = j To 3
ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = valori_spalm(k)
i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If
Next k


End If

quarto = WorksheetFunction.Ceiling(mese / 3, 1)
squarto = quarto & "Q" & anno

r = 1
c = 1

Set sqa = ActiveSheet.Range("B10:B16").Find(squarto, LookIn:=xlValues)
If Not sqa Is Nothing Then
    r = sqa.Row
    c = sqa.Column
End If

Wend



'MsgBox (mese & " " & anno)



'cercare in foglio reuters il season e se la data è di oggi allora moltiplicare il suo valore per i pesi in valori_spalm per ottenere i singoli valori mese



If mese < 10 And mese >= 4 Then sstagione = "S-" & anno Else sstagione = "W-" & anno


r = 1
c = 1

Set sqa = ActiveSheet.Range("B19:B20").Find(sstagione, LookIn:=xlValues)
If Not sqa Is Nothing Then
    r = sqa.Row
    c = sqa.Column
End If

While Not sqa Is Nothing And ActiveSheet.Cells(r, c + 3) = Date

If Not sqa Is Nothing And ActiveSheet.Cells(sqa.Row, sqa.Column + 3) = Date Then

valore = ActiveSheet.Cells(sqa.Row, sqa.Column + 1)

ReDim mesi_spalm(1 To 6)

Select Case InStr(sstagione, "S-")
Case Is > 0
    mesi_spalm(1) = mesi(4) & anno
    mesi_spalm(2) = mesi(5) & anno
    mesi_spalm(3) = mesi(6) & anno
    mesi_spalm(4) = mesi(7) & anno
    mesi_spalm(5) = mesi(8) & anno
    mesi_spalm(6) = mesi(9) & anno
Case Is = 0
    mesi_spalm(1) = mesi(10) & anno
    mesi_spalm(2) = mesi(11) & anno
    mesi_spalm(3) = mesi(12) & anno
    mesi_spalm(4) = mesi(1) & (anno + 1)
    mesi_spalm(5) = mesi(2) & (anno + 1)
    mesi_spalm(6) = mesi(3) & (anno + 1)
End Select

For j = 1 To 6
If mesi(mese) & anno = mesi_spalm(j) Then Exit For
Next j


If j > 1 Then ReDim valor(1 To (j - 1)) Else ReDim valor(0)

For pp = 1 To (j - 1)

valor(pp) = ActiveSheet.Cells(i - pp, 11)

Next pp

valori_spalm = spalma_mesi(mesi_spalm, valor, valore)


For k = j To 6
ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = valori_spalm(k)
i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If
Next k


End If

If mese < 10 And mese >= 4 Then sstagione = "S-" & anno Else sstagione = "W-" & anno

r = 1
c = 1
Set sqa = ActiveSheet.Range("B19:B20").Find(sstagione, LookIn:=xlValues)
If Not sqa Is Nothing Then
    r = sqa.Row
    c = sqa.Column
End If

Wend




'MsgBox (mese & " " & anno)




'cercare in foglio reuters il year e se la data è di oggi allora moltiplicare il suo valore per i pesi in valori_spalm per ottenere i singoli valori mese




r = 1
c = 1

Set sqa = ActiveSheet.Range("B23:B26").Find("20" & anno, LookIn:=xlValues)
If Not sqa Is Nothing Then
    r = sqa.Row
    c = sqa.Column
End If

While Not sqa Is Nothing And ActiveSheet.Cells(r, c + 3) = Date

If Not sqa Is Nothing And ActiveSheet.Cells(sqa.Row, sqa.Column + 3) = Date Then

valore = ActiveSheet.Cells(sqa.Row, sqa.Column + 1)

ReDim mesi_spalm(1 To 12)


    mesi_spalm(1) = mesi(1) & anno
    mesi_spalm(2) = mesi(2) & anno
    mesi_spalm(3) = mesi(3) & anno
    mesi_spalm(4) = mesi(4) & anno
    mesi_spalm(5) = mesi(5) & anno
    mesi_spalm(6) = mesi(6) & anno
    mesi_spalm(7) = mesi(7) & anno
    mesi_spalm(8) = mesi(8) & anno
    mesi_spalm(9) = mesi(9) & anno
    mesi_spalm(10) = mesi(10) & anno
    mesi_spalm(11) = mesi(11) & anno
    mesi_spalm(12) = mesi(12) & anno

For j = 1 To 12
If mesi(mese) & anno = mesi_spalm(j) Then Exit For
Next j

If j > 1 Then ReDim valor(1 To (j - 1)) Else ReDim valor(0)

For pp = 1 To (j - 1)

valor(pp) = ActiveSheet.Cells(i - pp, 11)

Next pp

valori_spalm = spalma_mesi(mesi_spalm, valor, valore)



For k = j To 12
ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = valori_spalm(k)
i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If
Next k


End If

r = 1
c = 1
Set sqa = ActiveSheet.Range("B23:B26").Find("20" & anno, LookIn:=xlValues)
If Not sqa Is Nothing Then
    r = sqa.Row
    c = sqa.Column
End If

Wend


'MsgBox (mese & " " & anno)

tro = mesi(mese) & anno
Set sqa = ThisWorkbook.Sheets("ICE").Range("A:A").Find(tro, LookIn:=xlValues)

While Not sqa Is Nothing

ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = ThisWorkbook.Sheets("ICE").Cells(sqa.Row, 5) / 1000
ActiveSheet.Cells(i, 10).Interior.Color = RGB(0, 255, 255)
ActiveSheet.Cells(i, 11).Interior.Color = RGB(0, 255, 255)

i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If


tro = mesi(mese) & anno
Set sqa = ThisWorkbook.Sheets("ICE").Range("A:A").Find(tro, LookIn:=xlValues)
Wend

Pulsante3_Click

End Function


Public Function spalma_mesi(mesi() As String, valo() As Double, media_imp As Double) As Variant

Dim sm() As Double
Dim variazione() As Double
Dim media As Double
Dim nummes As Integer
Dim trov As Range

ReDim sm(1 To UBound(mesi))
ReDim variazione(1 To UBound(mesi))

media_imp = media_imp * 1000

media = 0
nummes = 0

For i = LBound(mesi) To UBound(mesi)
Set trov = ThisWorkbook.Sheets("ICE").Range("A:A").Find(mesi(i), LookIn:=xlValues)

If Not trov Is Nothing Then
    If Not IsEmpty(valo) And i <= UBound(valo) Then sm(i) = valo(i) * 1000 Else sm(i) = ThisWorkbook.Sheets("ICE").Cells(trov.Row, trov.Column + 4)
    variazione(i) = ThisWorkbook.Sheets("ICE").Cells(trov.Row, trov.Column + 4)
    media = media + variazione(i)
    nummes = nummes + 1
End If

Next i

media = media / nummes

For ll = LBound(mesi) To UBound(mesi)

variazione(ll) = 1 - (variazione(ll) - media) / media

Next ll




For i = UBound(valo) + 1 To UBound(sm)


sm(i) = (1 - (media - sm(i)) / media) * media_imp

Next i


nummes = 0
media = 0

For i = LBound(sm) To UBound(sm)
nummes = nummes + 1
media = media + sm(i)
Next i
media = media / nummes


While Abs(media - media_imp) > 0.1

va = media_imp - media

For i = UBound(valo) + 1 To UBound(sm)
If va > 0 Then sm(i) = sm(i) + 0.1 Else sm(i) = sm(i) - 0.1
Next i

nummes = 0
media = 0

For i = LBound(sm) To UBound(sm)
nummes = nummes + 1
media = media + sm(i)
Next i
media = media / nummes

Wend

For i = LBound(sm) To UBound(sm)
sm(i) = sm(i) / 1000
Next i


spalma_mesi = sm

End Function

Answer 1

因為正如@Skaterhaz所述， LBOUND(mesi)等於1，並且(Int(Mid(12, 4, 2)) + 1) LBOUND(mesi) (Int(Mid(12, 4, 2)) + 1)將返回0，因此您需要在公式中加1。

Dim mesi（1至12）作為字符串

mese =（Int（Mid（oggi，4，2））+1）Mod 12 +1