假设无限循环 - cleart.contnts运行时错误1004

时间：2018-03-30 19:14:21

标签： excel vba infinite-loop

作为一名永远的VBA新手，我再次来到这里寻求你的帮助。 我写了这段代码：

Public ANNO As String

Sub FIFO_new()
Worksheets(15).Select
Call FifoCanc
Dim fifodest As Worksheet, fifosource As Worksheet
Dim ColumnA As Variant, ColumnB As Variant, ColumnE As Variant, ColumnF As Variant, ColumnL As Variant
Dim ColumnR As Variant, ColumnS As Variant, ColumnQ As Variant, ColumnU As Variant, ColumnT As Variant
Dim E As Integer, F As Integer
INIZIO:

'-----------------------------------------------
Set fifodest = Worksheets(15)
F = fifodest.Range("M2").Value
'------------------------------------------------
'AGGIUNGI/TOGLI RIGHE A FOGLIO VUOTO
If F = 0 Or F = -1 Then
    D = Range("D3").End(xlDown).Row
Else
    D = Range("D3").End(xlDown).End(xlDown).Row
End If
D = D - 1
With Range("A3:A" & D)
.NumberFormat = "dd/mm/yyyy"
End With
With Range("E3:E" & D)
.NumberFormat = "##,###,##0.00 ""KG"""
End With
With Range("F3:F" & D)
.NumberFormat = "##,##0.00 ""€/KG"""
End With
With Range("G3:G" & D)
.NumberFormat = "€ #,##0.00"
End With

If D < 14 And (F = 0 Or F = -1) Then
    MsgBox ("RIGHE INSUFFICIENTI")
    Range("A" & (F + 3)).Select
    H = ActiveCell.Row
    Do Until D = 15
        If F = 0 Or F = -1 Then
            F = 4
        End If
        Range("A" & F & ":L" & F).Select
        Range("A" & F & ":L" & F).Insert shift:=xlDown
        If F = 0 Or F = -1 Then
            D = Range("D3").End(xlDown).Row
        Else
            D = Range("D3").End(xlDown).End(xlDown).Row
        End If
    Loop
ElseIf D > 15 And (F = 0 Or F = -1) Then
'    D = Range("D1048576").End(xlUp).Row
    K = (D - 15)
    If F = 0 Or F = -1 Then
        F = 3
    End If
    Range("A" & F & ":L" & (F + K)).Delete shift:=xlUp
End If
'------------------------------------------------

li:
C = InputBox("INIZIO INTERVALLO (DA 1 A 12)")
D = InputBox("FINE INTERVALLO (DA 1 A 12)")
C = C + 1
D = D + 1
If D - C < 0 Then
    MsgBox ("iniziale sempre < di finale")
    GoTo li
End If

For I = C To D
Set fifosource = Worksheets(I)
E = fifosource.Range("V6").Value
If E = 0 Then
    GoTo vainext
End If
Set ColumnR = fifosource.Range("R7:R" & (E + 6))
Set ColumnS = fifosource.Range("S7:S" & (E + 6))
Set ColumnQ = fifosource.Range("Q7:Q" & (E + 6))
Set ColumnU = fifosource.Range("U7:U" & (E + 6))
Set ColumnT = fifosource.Range("T7:T" & (E + 6))

'AGGIUNGI RIGHE---------------------------------------
F = fifodest.Range("M2").Value
If F = 0 Or F = -1 Then
    L = Range("D3").End(xlDown).Row
Else
    L = Range("D3").End(xlDown).End(xlDown).Row
End If
L = L - 1
    If L < 14 Then
        GoTo INIZIO
        I = Nothing
    ElseIf L < (14 + (E + (F + 1))) Then
            If F = 0 Or F = -1 Then
                M = 4
            Else
                M = F + 3
            End If
            Range("A" & M & ":L" & (M + (E - 1))).Insert shift:=xlDown
'            D = Range("D1048576").End(xlUp).Row
    End If
'------------------------------------------------------

If F = 0 Or F = -1 Then
    M = 3
End If
Set ColumnA = fifodest.Range("A" & M & ":A" & (E + (M - 1)))
ColumnA.Select
ColumnA.Value = ColumnR.Value
Set ColumnB = fifodest.Range("B" & M & ":B" & (E + (M - 1)))
ColumnB.Value = ColumnS.Value
Set ColumnE = fifodest.Range("E" & M & ":E" & (E + (M - 1)))
ColumnE.Value = ColumnQ.Value
Set ColumnF = fifodest.Range("F" & M & ":F" & (E + (M - 1)))
ColumnF.Value = ColumnU.Value
Set ColumnL = fifodest.Range("L" & M & ":L" & (E + (M - 1)))
ColumnL.Value = ColumnT.Value
Call Gformula
vainext:
Next
fifodest.Select

Set fifodest = ActiveSheet '------

F = fifodest.Range("M2").Value
If F <= 0 Then
    L = Range("D3").End(xlDown).Row
Else
    L = Range("D3").End(xlDown).End(xlDown).Row
End If
L = L - 1

'elimina righe in eccesso
If F > 0 And L - F > 7 Then
K = (L - (F + 2)) - 7
Range("A" & (F + 4) & ":L" & (F + 2 + K)).Delete shift:=xlUp
End If

'calcolo valori ultima riga
F = fifodest.Range("M2").Value
If F <= 0 Then
    L = Range("D3").End(xlDown).Row
Else
    L = Range("D3").End(xlDown).End(xlDown).Row
End If

''L = L + 1
Range("A" & L).ClearContents
Range("A" & L).Value = Range("A" & (F + 2)).Value
Range("A" & L).Font.Bold = True

UserForm1.Show

For Each cell In Range("A3:A" & L)
If cell.Value <> "" Then
    cell.Value = Left(cell, 6) & ANNO 'Right(cell, 4) = ANNO
End If
Next

With Range("A3:A" & L)
.NumberFormat = "dd/mm/yyyy"
.NumberFormat = "mm/dd/yyyy"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With

With Range("H3:K" & L)
.NumberFormat = "#,##0.00"
.Interior.ColorIndex = 2
End With

With Range("D" & L)
.ClearContents
.Value = "Totali"
.Font.Bold = True
End With

With Range("E" & L)
.ClearContents
.Value = WorksheetFunction.Sum(Range("E3:E" & (L - 1)).Value)
.Font.Bold = True
.NumberFormat = "##,###,##0.00 ""KG"""
End With

With Range("G" & L)
.ClearContents
.Formula = "=SUM(G3:G" & (L - 1) & ")"
.Font.Bold = True
.NumberFormat = "€ #,##0.00"
End With

With Range("L" & L)
.ClearContents
.Value = WorksheetFunction.Sum(Range("L3:L" & (L - 1)).Value)
.Font.Bold = True
End With

Call WidthColonna
B = 0
For I = C To D
A = Worksheets(I).Range("V6").Value
B = A + B
Next
F = Range("M2").Value
If B <> F Then
    Range("M2").Interior.ColorIndex = 3
Else
    Range("M2").Interior.ColorIndex = 10
End If
ActiveSheet.Protect Password:="ponzio"
End Sub


Sub Gformula()
Dim cella As Range, cella2 As Range
B = Range("M2").Value + 1
If F <= 0 Then
    A = Range("D3").End(xlDown).Row
Else
    A = Range("D3").End(xlDown).End(xlDown).Row
End If
A = A - 1

Set cella = Range("G3")
    cella.Select
    If cella.FormulaArray <> "" And cella.Row = 3 Then
        GoTo dopo
    End If
    cella.ClearContents
    cella.FormulaArray = "=IF(RC5>=0,RC[-2]*RC[-1],-(MAX(IF(R2C8:RC8<-SUMIF(R2C5:RC5,""<0""),R2C9:RC9))-(SUMIF(R2C5:RC5,""<0"")+MAX(IF(R2C8:RC8<-SUMIF(R2C5:RC5,""<0""),R2C8:RC8)))*INDEX(R2C6:RC6,MATCH(MIN(IF(R2C8:RC8>=-SUMIF(R2C5:RC5,""<0""),R2C8:RC8)),R2C8:RC8,0))+1111))"
    cella.Replace "1111", "SUMIF(OFFSET(G3,-1,0,-ROW(G3)+1,1),""<0"")"
dopo:
Range("G4:G" & A).ClearContents
If B = 1 Then
   GoTo qui
End If
Range("G3").Select
    Selection.AutoFill Destination:=Range("G3:G" & (B + 1)), Type:=xlFillDefault
qui:
Set cella2 = Range("G3:G" & A)
'    For Each cell In cella2
'        If WorksheetFunction.IsNA(cell) = True Then
'            cell.Value = cell.Offset(0, -5).Value * (cell.Offset(-1, -3).Value / cell.Offset(-1, -5).Value)
'        End If
'    Next


Call Dformula
End Sub

Sub Dformula()
Dim cella As Range, cella2 As Range
B = Range("M2").Value + 1
If F <= 0 Then
    A = Range("D3").End(xlDown).Row
Else
    A = Range("D3").End(xlDown).End(xlDown).Row
End If
A = A - 1
Set cella = Range("D3")
    cella.Select
    If cella.FormulaArray <> "" And cella.Row = 3 Then
        GoTo dopo
    End If
    cella.ClearContents
    cella.FormulaArray = "=IF(E3>0,""Entrata"",IF(E3<0,""Uscita"",""-""))"

dopo:
Range("D4:D" & A).ClearContents
If B = 1 Then
   GoTo qui
End If
Range("D3").Select
    Selection.AutoFill Destination:=Range("D3:D" & (B + 1)), Type:=xlFillDefault
qui:
Call Hformula
End Sub

Sub Hformula()
Dim cella As Range, cella2 As Range
B = Range("M2").Value + 1
If F <= 0 Then
    A = Range("D3").End(xlDown).Row
Else
    A = Range("D3").End(xlDown).End(xlDown).Row
End If
A = A - 1
Set cella = Range("H3")
    cella.Select
    If cella.FormulaArray <> "" And cella.Row = 3 Then
        GoTo dopo
    End If
    cella.ClearContents
    cella.FormulaArray = "=SUMIF($E$3:$E3,"">0"")"
dopo:
Range("H4:H" & A).ClearContents
If B = 1 Then
   GoTo qui
End If
Range("H3").Select
    Selection.AutoFill Destination:=Range("H3:H" & (B + 1)), Type:=xlFillDefault
qui:
Call Iformula
End Sub

Sub Iformula()
Dim cella As Range, cella2 As Range
B = Range("M2").Value + 1
If F <= 0 Then
    A = Range("D3").End(xlDown).Row
Else
    A = Range("D3").End(xlDown).End(xlDown).Row
End If
A = A - 1
Set cella = Range("I3")
    cella.Select
    If cella.FormulaArray <> "" And cella.Row = 3 Then
        GoTo dopo
    End If
    cella.ClearContents
    cella.FormulaArray = "=SUMIF($E$3:$E3,"">0"",$G$3:$G3)"
dopo:
Range("I4:I" & A).ClearContents
If B = 1 Then
   GoTo qui
End If
Range("I3").Select
    Selection.AutoFill Destination:=Range("I3:I" & (B + 1)), Type:=xlFillDefault
qui:
Call Jformula
End Sub

Sub Jformula()
Dim cella As Range, cella2 As Range
B = Range("M2").Value + 1
If F <= 0 Then
    A = Range("D3").End(xlDown).Row
Else
    A = Range("D3").End(xlDown).End(xlDown).Row
End If
A = A - 1
Set cella = Range("J3")
    cella.Select
    If cella.FormulaArray <> "" And cella.Row = 3 Then
        GoTo dopo
    End If
    cella.ClearContents
    cella.FormulaArray = "=IF(ROW(RC10)=3,RC5,R[-1]C10+RC5)"
dopo:
Range("J4:J" & A).ClearContents
If B = 1 Then
   GoTo qui
End If
Range("J3").Select
    Selection.AutoFill Destination:=Range("J3:J" & (B + 1)), Type:=xlFillDefault
qui:
Call Kformula
End Sub
Sub Kformula()
Dim cella As Range, cella2 As Range
B = Range("M2").Value + 1
If F <= 0 Then
    A = Range("D3").End(xlDown).Row
Else
    A = Range("D3").End(xlDown).End(xlDown).Row
End If
A = A - 1
Set cella = Range("K3")
    cella.Select
    If cella.FormulaArray <> "" And cella.Row = 3 Then
        GoTo dopo
    End If
    cella.ClearContents
    cella.FormulaArray = "=IF(ROW(RC11)=3,RC7,R[-1]C11+RC7)"
dopo:
Range("K4:K" & A).ClearContents
If B = 1 Then
   GoTo qui
End If
Range("K3").Select
    Selection.AutoFill Destination:=Range("K3:K" & (B + 1)), Type:=xlFillDefault
qui:
End Sub

Sub WidthColonna()
With Worksheets(15)
.ColumnS(5).ColumnWidth = 15
.ColumnS(7).ColumnWidth = 12
.ColumnS(8).ColumnWidth = 12
.ColumnS(9).ColumnWidth = 12
.ColumnS(10).ColumnWidth = 12
.ColumnS(11).ColumnWidth = 12
.ColumnS(12).ColumnWidth = 8
End With
H = Range("M2").Value
If H > 4990 Then
    MsgBox ("ATTENZIONE: LINEE RECORDS > 5000")
    Exit Sub
End If

End Sub

Sub FifoCanc()
Worksheets(15).Select
ActiveSheet.Unprotect Password:="ponzio"
F = Range("m2").Value

If F > 0 Then
    D = Range("D3").End(xlDown).End(xlDown).Row - 1
ElseIf F = -1 Or F = 0 Then
    D = Range("D3").End(xlDown).Row - 1
End If
G = InputBox("CANCELLO TUTTO? (S/N)")
G = UCase(G)
If G = "S" Then
    Range("A3:L" & D).ClearContents
End If
End Sub

当它调用fifocan子例程时，在需要清除内容的行中，它被卡住并返回

  

运行时错误1004范围类的清除内容方法失败。

在其他被称为子例程中也会发生同样的事情：

  • Gformula
  • Hformula等。

当它到达range.clear contents的行时，它会被卡住。 某处肯定存在无限循环。

0 个答案:

没有答案
相关问题
最新问题