EXCEL VBA - 子程序中的长值增加

Question

我很难在我正在使用的代码上查看错误。

我设置了一个带有Long值（i）的Option Explicit，它正在作为当前行。第一行是5，所以基本上我设置了＆＃39; i＆＃39;作为5到lastRow但是在第4个宏之后，＆＃39; i＆＃39;从5转换为9。

说明：

  

开始i = 5

     

    

检查员i = 5

         

      

runall i = 5

             

        

macro1 i = 5         macro2 i = 5         macro3 i = 5         macro4 i = 9         macro5 i = 9         / runall         检查         /结束

      

    

  

以下代码：

Option Explicit
Dim i As Long
Dim lastRow As Long
Private Sub Worksheet_Change(ByVal Target As Range)
    lastRow = Range("F" & Rows.Count).End(xlUp).Row
    For i = 5 To lastRow
        If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("B" & i)) Is Nothing Then
            Range("C" & i).ClearContents
        End If
        If Not Intersect(Target, Range("F" & i)) Is Nothing Then
            Call Checker
        End If
        Next i
    End Sub
    Sub Checker()
        If (Range("B" & i).Text = "Insert") Then RunAll
    End Sub
    Sub RunAll()
        Call Tiers_1_to_3
        Call CI_Desc
        Call Tiers_Desc
        Call Site
        Call Support_Group_2
        Call Product_Name
    End Sub
    Sub Tiers_1_to_3()
        Range("G" & i & ":I" & i).FormulaArray = _
        "=IFERROR(VLOOKUP((MID(DeviceInfo!RC6,4,2)),Automated_Data!R2C1:R46C7,{2,3,4},FALSE),"""")"
    End Sub
    Sub CI_Desc()
        Range("M" & i).Value = "Source"
    End Sub
    Sub Tiers_Desc()
        Range("O" & i).Formula = _
        "=IFERROR(VLOOKUP((MID(DeviceInfo!RC6,4,2)),Automated_Data!R2C1:R46C7,5,FALSE),"""")"
    End Sub
    Sub Site()
        Range("P" & i).Formula = _
        "=IFERROR(VLOOKUP((LEFT(DeviceInfo!RC6,3)),Automated_Data!R2C11:R334C12,2,FALSE),""Please indicate Office or Site location"")"
    End Sub
    Sub Support_Group_2()
        Range("AT" & i & ":AV" & i).FormulaArray = _
        "=IFERROR(VLOOKUP((MID(DeviceInfo!RC6,4,2)),Automated_Data!R2C1:R46C7,{6,7},FALSE),"""")"
    End Sub
    Sub Product_Name()
        Range("J" & i).Formula = _
        "=IFERROR((INDIRECT(SUBSTITUTE(RC16,"" "",""_""))),""Please select Product Name"")"
        Range("K" & i).Formula = _
        "=IFERROR((INDIRECT(SUBSTITUTE(RC17,"" "",""_""))),""Please select Model Name"")"
    End Sub

这给了一个严肃的时间，因为我无法让这条线在同一行上工作，而是在它下降。

整个想法是在一个连接程序中工作，但它失败了。

提前感谢您的帮助！

更新＃1

我能够毫无问题地运行它。代码逐行运行，到目前为止我添加的值越来越多，因为现在更容易理解。

Option Explicit
Option Compare Text
Const SpecialCharacters As String = "!,@,#,$,%,^,&,*,(,),{,[,],}"
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long
    Dim LastRow As Long
    LastRow = Range("B" & Rows.Count).End(xlUp).Row
    For i = 5 To LastRow
        If Target.Cells.Count > 1 Then Exit Sub
            If Not Intersect(Target, Range("B" & i)) Is Nothing Then
                Range("C" & i).ClearContents
            End If
        If Not Intersect(Target, Range("D" & i)) Is Nothing Then
            Range("AT" & i & ":BV" & i).ClearContents
        End If
        If Not Intersect(Target, Range("F" & i)) Is Nothing Then
            If Range("F" & i).Value Like "*[!0-9,a-z,.]*" Then
                MsgBox "Please enter proper Device Name"
                Range("F" & i).Activate
            Else
                Range("G" & i & ":I" & i).ClearContents
                Range("AT" & i & ":BV" & i).ClearContents
                Call Checker(i)
            End If
        End If
    Next i
    End Sub
Sub Checker(argi As Long)
    If (Range("B" & argi).Text = "Insert") Then
        Call Tiers_1_to_3(argi)
        Call CI_Desc(argi)
        Call Tiers_Desc(argi)
        Call Site(argi)
        Call Support_Group_2(argi)
        Call Support_Group_3(argi)
        Call Product_Name(argi)
        Call Model_Name(argi)
        Call Mgmt_Components(argi)
        Call ITSM_Group(argi)
        Call Only_Values(argi)
        Call MandatoryColors(argi)
    End If
    Range("F" & argi + 1).Select
End Sub
Sub Tiers_1_to_3(argi As Long)
    Range("G" & argi & ":I" & argi).FormulaArray = _
    "=IFERROR(VLOOKUP((MID(DeviceInfo!RC6,4,2)),Automated_Data!R2C1:R46C7,{2,3,4},FALSE),"""")"
End Sub
Sub CI_Desc(argi As Long)
    Range("M" & argi).Value = "Source"
End Sub
Sub Tiers_Desc(argi As Long)
    Range("O" & argi).Formula = _
    "=IFERROR(VLOOKUP((MID(DeviceInfo!RC6,4,2)),Automated_Data!R2C1:R46C7,5,FALSE),"""")"
End Sub
Sub Site(argi As Long)
    Range("P" & argi).Formula = _
    "=IFERROR(VLOOKUP((LEFT(DeviceInfo!RC6,3)),Automated_Data!R2C11:R334C12,2,FALSE),""Please indicate Office or Site location"")"
End Sub
Sub Support_Group_2(argi As Long)
    If Range("D" & argi).Value = "Shared Fault Managed" Or Range("D" & argi).Value = "Fault Managed" Then
        Range("AT" & argi & ":AU" & argi).FormulaArray = _
        "=IFERROR(VLOOKUP((MID(DeviceInfo!RC6,4,2)),Automated_Data!R2C1:R46C7,{6,7},FALSE),"""")"
    End If
End Sub
Sub Support_Group_3(argi As Long)
    If Range("D" & argi).Value = "Shared Fault Managed" Then
        Range("AV" & argi).Value = "NOS-NOC-CCT-OPS-LEVEL3"
    End If
End Sub
Sub Product_Name(argi As Long)
    If Range("J" & argi).Value = "" Then
        Range("J" & argi).Formula = _
        "=IFERROR((INDIRECT(SUBSTITUTE(RC16,"" "",""_""))),""Please select Product Name"")"
    Else
    End If
End Sub
Sub Model_Name(argi As Long)
    If Range("K" & argi).Value = "" Then
        Range("K" & argi).Formula = _
        "=IFERROR((INDIRECT(SUBSTITUTE(RC17,"" "",""_""))),""Please select Model Name"")"
    Else
    End If
End Sub
Sub Mgmt_Components(argi As Long)
    If Range("D" & argi).Value = "Not Managed" Then
        Range("AY" & argi).Value = "No Agent"
        Range("AZ" & argi).Value = "Not Monitored"
        Range("BA" & argi).Value = "None"
    Else
        If Range("F" & argi).Value Like "*up*" Or Range("F" & argi).Value Like "*wp*" Then
        Range("AY" & argi).Value = "ICMP Only"
        Range("AZ" & argi).Value = "Zenoss-GTN"
        Range("BA" & argi).Value = "ICMP Only"
        Else
            If Range("J" & argi).Value Like "CISCO*" Then
                Range("AY" & argi).Value = "SNMP-CNC"
                Range("BE" & argi).Value = "161"
                Range("BF" & argi).Value = "SNMP-Zenoss"
                Range("BG" & argi).Value = "Linux and Network SNMP"
                Range("BL" & argi).Value = "161"
                If Range("F" & argi).Value Like "*gdn*" Then
                    Range("AZ" & argi).Value = "Zenoss-GDN"
                    Range("BA" & argi).Value = "CNC-DCN Server"
                    Range("BC" & argi).Value = "gdcn-ch33r5Guv"
                    Range("BH" & argi).Value = "Zenoss-GDN"
                    Range("BJ" & argi).Value = "gdcn-ch33r5Guv"
                Else
                    Range("AZ" & argi).Value = "Zenoss-GTN"
                    Range("BA" & argi).Value = "CNC-GTN Server"
                    Range("BC" & argi).Value = "Z3n0ss4u"
                    Range("BH" & argi).Value = "Zenoss-GTN"
                    Range("BJ" & argi).Value = "Z3n0ss4u"
                End If
            Else
                Range("AY" & argi).Value = "SNMP-Zenoss"
                Range("BA" & argi).Value = "Linux and Network SNMP"
                Range("BE" & argi).Value = "161"
                Range("BF" & argi).Value = "SNMP"
                Range("BG" & argi).Value = "Voyence"
                Range("BL" & argi).Value = "161"
                If Range("F" & argi).Value Like "*gdn*" Then
                    Range("AZ" & argi).Value = "Zenoss-GDN"
                    Range("BC" & argi).Value = "gdcn-ch33r5Guv"
                    Range("BH" & argi).Value = "CCO"
                    Range("BJ" & argi).Value = "gdcn-ch33r5Guv"
                Else
                    Range("AZ" & argi).Value = "Zenoss-GTN"
                    Range("BC" & argi).Value = "Z3n0ss4u"
                    Range("BH" & argi).Value = "GTN-DI"
                    Range("BJ" & argi).Value = "Z3n0ss4u"
                End If
            End If
        End If
    End If
End Sub
Sub ITSM_Group(argi As Long)
    If Range("D" & argi).Value = "Fault Managed" Or Range("D" & argi).Value = "Shared Fault Managed" Then
        Range("BV" & argi).Value = "Desk"
    End If
End Sub
Sub Only_Values(argi As Long)
    Range("B" & argi & ":CE" & argi).Copy
    Range("B" & argi & ":CE" & argi).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End Sub
Sub MandatoryColors(argi As Long)
    Dim myRange As Range
    Set myRange = Range("C" & argi & ",D" & argi & ",E" & argi & ",F" & argi & ",G" & argi & ",H" & argi & ",I" & argi & ",K" & argi & ",L" & argi & ",P" & argi & ",Q" & argi & ",R" & argi & ",S" & argi & ",T" & argi & ",U" & argi & ",V" & argi & ",W" & argi & ",X" & argi & ",Y" & argi & ",AY" & argi & ",AZ" & argi & ",BA" & argi & ",BC" & argi & ",BV5")
    If WorksheetFunction.CountA(myRange) = 0 Then
        myRange.Interior.ColorIndex = xlNone
        myRange.SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = 6
        MsgBox "Please complete highlighted Mandatory values"
    Else
    End If
End Sub

Answer 1

从它的外观来看，在某种程度上，我在调用你的宏时会改变它的值。基于此，我建议将i更改为过程级变量而不是模块级，然后将该值作为参数传递给子过程。

    Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long
    Dim lastRow As Long
    lastRow = Range("F" & Rows.Count).End(xlUp).Row
    For i = 5 To lastRow
        If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("B" & i)) Is Nothing Then
            Range("C" & i).ClearContents
        End If
        If Not Intersect(Target, Range("F" & i)) Is Nothing Then
            Call Checker(i)
        End If
        Next i
    End Sub
    Sub Checker( argi as long)
        If (Range("B" & argi).Text = "Insert") Then RunAll(argi)
    End Sub
    Sub RunAll(argi as long)
        Call Tiers_1_to_3(argi)
        Call CI_Desc(argi)
        Call Tiers_Desc(argi)
        Call Site(argi)
        Call Support_Group_2(argi)
        Call Product_Name(argi)
    End Sub
    Sub Tiers_1_to_3(argi as long)
        Range("G" & argi & ":I" & argi).FormulaArray = _
        "=IFERROR(VLOOKUP((MID(DeviceInfo!RC6,4,2)),Automated_Data!R2C1:R46C7,{2,3,4},FALSE),"""")"
    End Sub
    Sub CI_Desc(argi as long)
        Range("M" & argi).Value = "Source"
    End Sub
    Sub Tiers_Desc(argi as long)
        Range("O" & argi).Formula = _
        "=IFERROR(VLOOKUP((MID(DeviceInfo!RC6,4,2)),Automated_Data!R2C1:R46C7,5,FALSE),"""")"
    End Sub
    Sub Site(argi as long)
        Range("P" & argi).Formula = _
        "=IFERROR(VLOOKUP((LEFT(DeviceInfo!RC6,3)),Automated_Data!R2C11:R334C12,2,FALSE),""Please indicate Office or Site location"")"
    End Sub
    Sub Support_Group_2(argi as long)
        Range("AT" & argi & ":AV" & argi).FormulaArray = _
        "=IFERROR(VLOOKUP((MID(DeviceInfo!RC6,4,2)),Automated_Data!R2C1:R46C7,{6,7},FALSE),"""")"
    End Sub
    Sub Product_Name(argi as long)
        Range("J" & argi).Formula = _
        "=IFERROR((INDIRECT(SUBSTITUTE(RC16,"" "",""_""))),""Please select Product Name"")"
        Range("K" & argi).Formula = _
        "=IFERROR((INDIRECT(SUBSTITUTE(RC17,"" "",""_""))),""Please select Model Name"")"
    End Sub