运行时错误'9'VBA子脚本超出范围
[英]Run time error '9' VBA Subcript out of range
问题描述
I interited a sheet at work and there is no one who actually supports anything Excel related. 
我在工作中插入了一张工作表，没有人真正支持任何与Excel有关的东西。 My VBA is rather rusty and hence I hope that someone can help me out here. 我的VBA非常生锈，因此我希望有人可以在这里帮助我。
I have the following code: It goes in error at line If mesi(mese) = "JAN" Then anno = Int(Right(oggi, 2)) + 1 Else anno = Int(Right(oggi, 2)) and i get Run-time error '9': Subscript out of range I have not changed anything and it used to work for a long time. 我有以下代码： 如果mesi（mese）=“ JAN”，它会出错， 然后anno = Int（Right（oggi，2））+ 1其他anno = Int（Right（oggi，2））我得到运行时错误'9'：下标超出范围我没有进行任何更改，并且它可以正常工作很长时间。 I really appreciate any input 我真的很感谢任何投入
Many thanks 非常感谢
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
1 个解决方案
解决方案1
2 已采纳
Because, as @Skaterhaz stated, LBOUND(mesi) equals 1 and (Int(Mid(12, 4, 2)) + 1) will return 0 you will need to add one to your formula. 因为正如@Skaterhaz所述， LBOUND(mesi)等于1，并且(Int(Mid(12, 4, 2)) + 1) LBOUND(mesi) (Int(Mid(12, 4, 2)) + 1)将返回0，因此您需要在公式中加1。
Dim mesi(1 To 12) As String
mese = (Int(Mid(oggi, 4, 2)) + 1) Mod 12 + 1
声明:本站的技术帖子网页，遵循CC BY-SA 4.0协议，如果您需要转载，请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.
相关问题
运行时错误9超出脚本范围和发票自动化 - Run time error 9 subcript out of range and invoice automation
运行时错误9：字幕超出范围 - Runtime Error 9 : Subcript out of range
VBA 运行时错误“9”下标超出范围 - VBA run time error '9' Subscript out of range
vba-运行时错误“ 9”：下标超出范围 - vba - run time error '9': Subscript out of range
VBA 运行时错误9：下标超出范围 - VBA Run time error 9: Subscript out of range
VBA的范围导致“运行时错误9下标超出范围” - VBA's range causes “Run time error 9 Subscript out of range”
VBA错误运行时错误9下标超出范围 - VBA Error Run time error 9 Subscript Out of range
EXCEL VBA：运行时错误“ 9”：下标超出范围 - EXCEL VBA : Run-Time error '9': Subscript out of range
Excel VBA-运行时错误9（下标超出范围） - Excel VBA- Run time error 9 (Subscript out of range)
VBA运行时错误9：下标超出范围 - VBA run-time Error 9: subscript out of range
相关标签