使用" for" VBA无法正常工作环

时间:2017-08-29 13:30:39

标签: excel vba excel-vba

我有以下代码,它读取2个工作簿并放置一个vlookup函数

但问题是,当使用两个for循环时,(我猜)会先混淆哪个变量。 我想要的是首先应该采取ZS7_656.xls和NSA_103_A.xls 但它正在服用ZS7_656和DCA_656_A并且vlookup没有正常运行

有人可以帮忙吗?

Private Sub CommandButton1_Click()

    Prod = Array("ZS7_656", "PCO_656")
    Dev = Array("NSA_103", "DCA_656")
    For lngCounter1 = LBound(Dev) To UBound(Dev)
        For lngCounter = LBound(Prod) To UBound(Prod)

            Set x = Workbooks.Open("C:\Users\*****\Desktop\New folder\" & Prod(lngCounter) & ".xls")
            Set Z = Workbooks.Open("C:\Users\*****\Desktop\New folder\" & Dev(lngCounter1) & "_A.xls")

            With x.Sheets(Prod(lngCounter))
                Set aCell1 = .Range("A1:X1000") _
                    .Find(What:="User", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
                .Range(aCell1, .Cells(.Rows.Count, aCell1.Column).End(xlUp)) _
                    .Offset(2, 0) _
                    .Copy ThisWorkbook.Sheets(Prod(lngCounter)).Range("A2")
            End With

            LastRow = ThisWorkbook.Sheets(Prod(lngCounter)).Columns("A").Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row
            LastRow2 = Z.Sheets(Dev(lngCounter1) & "_A").Columns("B").Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row
            Set Table1 = ThisWorkbook.Sheets(Prod(lngCounter)).Range("A2:A" & LastRow)
            Set Table3 = Z.Sheets(Dev(lngCounter1) & "_A").Range("B1:B" & LastRow2)
            A1 = ThisWorkbook.Sheets(Prod(lngCounter)).Range("K2").Row
            A2 = ThisWorkbook.Sheets(Prod(lngCounter)).Range("K2").Column
            For Each Item In Table1
                On Error Resume Next
                ThisWorkbook.Sheets(Prod(lngCounter)).Cells(A1, A2) = Application.WorksheetFunction.VLookup(Item, Table3, 1, False)
                On Error GoTo 0
                A1 = A1 + 1
            Next Item

            x.Close
            Z.Close
        Next lngCounter
    Next lngCounter1
End Sub

2 个答案:

答案 0 :(得分:2)

我没有要测试的数据,但这是您可以尝试第一步的步骤:

>>> np.isnan([12.6,np.nan,0.5,4.6])
array([False,  True, False, False], dtype=bool)
>>> [math.isnan(x) for x in [12.6,np.nan,0.5,4.6]]
[False, True, False, False]
>>> [x for x in [12.6,np.nan,0.5,4.6] if x == x]
[12.6, 0.5, 4.6]

答案 1 :(得分:0)

要弄清楚你的代码究竟在做什么,真的太难了。你正在使用神秘的名字和复杂的方法来做事,更不用说没有声明变量了。

Rubberduck的帮助下,我稍微重构了你的代码(主要是重命名未声明的变量),添加了Option Explicit,并声明了所有本地人。

请注意有意义的名称如何使代码更容易维护:

Option Explicit

Private Sub CommandButton1_Click()

    Dim prodBookNames() As String
    prodBookNames = Array("ZS7_656", "PCO_656")
    Dim devBookNames() As String
    devBookNames = Array("NSA_103", "DCA_656")

    Dim devBookIndex As Long
    For devBookIndex = LBound(devBookNames) To UBound(devBookNames)
        Dim prodBookIndex As Long
        For prodBookIndex = LBound(prodBookNames) To UBound(prodBookNames)

            Dim devBook As Workbook
            Set devBook = Workbooks.Open("C:\Users\*****\Desktop\New folder\" & devBookNames(devBookIndex) & "_A.xls")

            Dim prodBook As Workbook
            Set prodBook = Workbooks.Open("C:\Users\*****\Desktop\New folder\" & prodBookNames(prodBookIndex) & ".xls")

            With prodBook.Sheets(prodBookNames(prodBookIndex))
                Dim aCell1 As Range 'whatever that means
                Set aCell1 = .Range("A1:X1000").Find(What:="User", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
                'BUG: Range.Find may return Nothing, causing run-time error 91 here.
                .Range(aCell1, .Cells(.Rows.Count, aCell1.Column).End(xlUp)) _
                    .Offset(2, 0) _
                    .Copy ThisWorkbook.Sheets(prodBookNames(prodBookIndex)).Range("A2")
            End With

            'BUG: Range.Find may return Nothing, causing run-time error 91 here.
            Dim prodLastRow As Long
            prodLastRow = ThisWorkbook.Sheets(prodBookNames(prodBookIndex)).Columns("A").Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row
            'BUG: Range.Find may return Nothing, causing run-time error 91 here.
            Dim devLastRow As Long
            devLastRow = devBook.Sheets(devBookNames(devBookIndex) & "_A").Columns("B").Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row

            Dim prodColumnA As Range
            Set prodColumnA = ThisWorkbook.Sheets(prodBookNames(prodBookIndex)).Range("A2:A" & prodLastRow)

            Dim devColumnB As Range
            Set devColumnB = devBook.Sheets(devBookNames(devBookIndex) & "_A").Range("B1:B" & devLastRow)

            'NOTE: initialized to constant value 2
            Dim prodCurrentRow As Long
            prodCurrentRow = ThisWorkbook.Sheets(prodBookNames(prodBookIndex)).Range("K2").Row
            'NOTE: initialized to constant value 11
            Dim prodCurrentColumn As Long
            prodCurrentColumn = ThisWorkbook.Sheets(prodBookNames(prodBookIndex)).Range("K2").Column

            Dim item As Range
            For Each item In prodColumnA
                ThisWorkbook.Sheets(prodBookNames(prodBookIndex)).Cells(prodCurrentRow, prodCurrentColumn) = Application.VLookup(item, devColumnB, 1, False)
                prodCurrentRow = prodCurrentRow + 1
            Next item

            prodBook.Close
            devBook.Close

        Next prodBookIndex
    Next devBookIndex
End Sub

注意,我已使用后期绑定Application.WorksheetFunction.VLookup等效替换Application.VLookup调用(忽略查找错误),而返回错误值引发运行时错误 - 它的VBA惯用性稍差,但是当没有错误发生时你不需要假装没有错误发生。

As was noted in comments,您的嵌套循环正在执行(D0, P0), (D0, P1), (D1, P0), (D1, P1)。如果您需要DxPx使用相同的索引,那么您只需要一个循环。

问题在于,这会让您留下可能不匹配的“双阵列”,但从概念上讲,您需要的是“一对”。事实证明,有一个数据结构,它正好用于存储“一对” - 看看Scripting.Dictionary可以为你做什么。

Dim pairs As Scripting.Dictionary
Set pairs = New Scripting.Dictionary
With pairs
    .Add "ZS7_656", "NSA_103"
    .Add "PCO_656", "DCA_656"
End With

然后你可以迭代字典的Keys数组,并为你正在迭代的每个检索关联的:比“twin”更强大数组“,这是任何语言的代码气味。

Dim keys As Variant
keys = pairs.keys
Dim i As Long
For i = LBound(keys) To UBound(keys)

    Dim prodBookName As String
    prodBookName = keys(i)

    Dim devBookName As String
    devBookName = pairs(prodBookName)

    'loop body

Next