EXCEL VBA-子例程中的Long Value增加 [英] EXCEL VBA - Long Value increasing within subroutines

查看：51
本文介绍了EXCEL VBA-子例程中的Long Value增加的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我很难在我正在使用的代码上看到错误.

I'm having a hard time trying to see the error on the code I'm working with.

我已将Option Explicit设置为Long值(i)，该值正作为当前行使用.第一行是5，所以基本上我将'i'设置为5到lastRow，但是在第4个宏之后，'i'从5转换为9.

I've set a Option Explicit with a Long value (i) which is which is working as the current row. The first row is 5 so basically I'm setting 'i' as 5 to lastRow but after the 4th macro the 'i' converts from a 5 into a 9.

说明:

开始我= 5

检查器i = 5

checker i = 5

runall i = 5

runall i = 5

macro1 i = 5宏2我= 5宏3我= 5宏4我= 9宏5我= 9/runall检查器/结束

macro1 i = 5 macro2 i = 5 macro3 i = 5 macro4 i = 9 macro5 i = 9 /runall checker /end

以下代码:

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

这给了我一个严重的时间，因为我无法让那条线在同一行上工作，相反它一直在下降.

This is giving a serious time coz I'm unable to get that line to be working on the same row, instead its going down.

整个想法是在连接过程中工作，但失败了.

The whole idea is to be working in a concatenate procedure but it's failing.

在此先感谢您的帮助！

更新#1

我能够毫无问题地运行它.该代码逐行运行，由于现在更容易理解，因此我现在添加了越来越多的值.

I was able to make it run without any issues. The code works row by row, and by now I'm adding more and more values since now is more easy to understand.

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

推荐答案

从它的外观看，在某些时候我在调用宏时更改了它的值.基于此，我建议将i更改为过程级别变量而不是模块级别，然后将该值作为参数传递给子过程.

From the looks of it, at some point the value i is getting changed while its calling your macros. Based on that, I'd suggest changing i to a procedure level variable instead of a module level, and then pass the value along as a parameter to the sub procedures.

    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

这篇关于EXCEL VBA-子例程中的Long Value增加的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！

查看全文
相关文章
其他开发最新文章
热门教程
热门工具
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆