Visual Basic，VBA数组循环 [英] Visual Basic, VBA array loop

问题描述

我使用 http://www.homeandlearn.org/arrays_and_loops.html 来提供帮助我就是这个.

I used http://www.homeandlearn.org/arrays_and_loops.html to help me with this.

我有过滤到一张桌子的数据连接.不幸的是，当程序将文件导出到Excel时，其中一个来源随机地将错误的数据(通常是日期)放置在错误的列(客户"列)中.我想做的事情类似于索引/匹配函数.我想对照同一工作簿中的另一个表(B)检查此主表(A)中的每个预订号.如果来自另一张纸(B)的预订号与主表(A)中的预订号匹配，我想在主表(A)中输入正确的客户值.我对VBA还是很陌生，因此感谢您的帮助.我试图在这里和那里修改我的代码，但无济于事.另外，我最初是在没有实际数据的情况下将其作为练习来进行的，因此我没有弄乱我的原始文件.我尝试添加适当的语法来引用其他工作表，但我想可能也会输入错误.这是我想出的最接近的原始代码:

I have data connections that filter to one table. Unfortunately one of the sources randomly places incorrect data (usually a date) in the wrong column (Client column) when the program exports the file to Excel. What I'd like to do is something similar to an index/match function. I'd like to check each reservation number in this master table (A) against another table (B) within the same workbook. If the reservation number from the other sheet (B) matches the reservation number in the master table (A), I would like to have the correct Client value entered into the master table (A). I'm still pretty new to VBA so any help is appreciated. I've tried to modify my code here and there but to no avail. Also, I was originally running this as a practice without the real data so I didn't mess up my original file. I tried to add the appropriate syntax to refer to other sheets and whatnot so I suppose that could be entered incorrectly as well. Here's the closest original code I came up with:

Sub TransferData()
Dim MyArray(1 To 19) As Single

MyArray(1) = 81899
MyArray(2) = 87172
MyArray(3) = 87275
MyArray(4) = 87394
MyArray(5) = 87446
MyArray(6) = 87496
MyArray(7) = 87621
MyArray(8) = 87631
MyArray(9) = 87726
MyArray(10) = 87822
MyArray(11) = 87858
MyArray(12) = 88041
MyArray(13) = 88097
MyArray(14) = 88127
MyArray(15) = 88160
MyArray(16) = 88191
MyArray(17) = 88359
MyArray(18) = 88487
MyArray(19) = 88545

For i = 1 To 19
    If Worksheets("Sheet1").Range("B" & i).Value = MyArray(i) Then
       Worksheets("Sheet2").Range("P" & i).Value = _ 
       Worksheets("Sheet1").Range("E" & i).Value
    End If
Next i

End Sub

我不记得该错误，因为该代码与上面的代码不完全相同，但与之接近.我相信它遇到的问题是，当i变量超过19时，系统找不到大于19的数组.我需要VBA来检查当前变化为3k +的行数中的19个数组.我试图添加另一个变量，如果我将变量分开，则可以让VBA针对所有行检查19个数组.这是我为此想到的代码....

I don't recall the error because the code wasn't exactly as above but close to it. I believe the issue it was running into was that when the i variable went above 19, the system couldn't find arrays > 19. I need VBA to check 19 arrays in an ever changing number of rows that's currently at 3k+. I attempted to add another variable thinking if I kept the variables separate, I could have VBA check the 19 arrays against all the rows. Here's the code I came up with for that....

Sub TransferData()
Dim MyArray(1 To 19) As Single

MyArray(1) = 81899
MyArray(2) = 87172
MyArray(3) = 87275
MyArray(4) = 87394
MyArray(5) = 87446
MyArray(6) = 87496
MyArray(7) = 87621
MyArray(8) = 87631
MyArray(9) = 87726
MyArray(10) = 87822
MyArray(11) = 87858
MyArray(12) = 88041
MyArray(13) = 88097
MyArray(14) = 88127
MyArray(15) = 88160
MyArray(16) = 88191
MyArray(17) = 88359
MyArray(18) = 88487
MyArray(19) = 88545

For i = 1 To 5000
For j = 1 To 19
If Worksheets("Sheet1").Range("B" & i).Value = MyArray(j) Then
    Worksheets("Sheet2").Range(i, 16).Value = Worksheets("Sheet1"). _ 
    Range(i,5).Value
    Next j
End If
Next i

End Sub

使用此代码，我得到编译错误:没有For的下一个.在在线搜索中，我发现这可能是因为我有2个"For"，一个if语句，一个if语句内的"next"语句，以及另一个位于循环外的"next"语句.我以为必须这样做，以便B列中的每个单元格都对照所有数组可能性进行检查.

With this code I get compile error: Next without For. In searching online I found it might be because I have 2 "For"s, an if statement, "next" statement within the if statement, then another "next" statement outside of the loop. I was thinking it had to be done this way so that each cell in the B column gets checked against all the array possibilities.

请参见下面的图片.当工作表:TMRtoSPIde的K列中的保留号与工作表:RawData中的保留项匹配时，我需要将工作表:TMRtoSPIde中的列P(实际计费名称)的值输入到工作表:RawData中的列D(计费名称)中.您会注意到该工作表:RawData在Billing Name列中有一个错误的5位数字序列日期.这些是我要替换的.

See pictures below. I need the value of Column P (Actual Billing Name) from sheet: TMRtoSPIde to be entered into Column D (Billing Name) on sheet: RawData when the Reservation # in Column K from sheet: TMRtoSPIde matches the reservation in sheet: RawData. You'll notice the sheet: RawData has an erroneous 5 digit serial date in the Billing Name column. These are what I'm trying to replace.

推荐答案

字典和集合是匹配唯一值的理想选择.在此示例中，我使用Scripting.Dictionary存储唯一ID以及对找到的EntireRow的引用.

Dictionaries and Collections are ideal for matching unique values. In this example I use a Scripting.Dictionary to store Unique ID's and references to the EntireRow that they are found.

注意:Range().Range()将返回相对于第一个范围对象的引用(例如Range("A10").EntireRow.Range("ZZ1").Address返回$ZZ$10).

Note: Range().Range() will return a reference that is relative to the first range object (e.g. Range("A10").EntireRow.Range("ZZ1").Address returns $ZZ$10).

仅存储所需的值会更简单，我只是想证明您可以将对象引用存储在Dictionary中.重要的是要注意，您可以将对象同时存储为字典中的键和/或值.人们常犯的一个错误是尝试将范围引用存储为键dictionary.Add Cells(1,1), Cells(1,2)会将对Cells(1,1)的引用存储为键，而将Cells(1,2)的值存储为键.这样做的问题在于，字典不知道如何比较单元格，因此您将无法基于其中的关键关系来查找值. dictionary.Add Cells(1,1).Value, Cells(1,2)是正确的语法.

It would have simpler to store just the needed value, I just wanted to demonstrate that you can store Objects references in a Dictionary. It is important to note that you can store Objects as both keys and/or values in a Dictionary. A common mistake people make is to try and store range references as keys dictionary.Add Cells(1,1), Cells(1,2) will store a reference to Cells(1,1) as a key and Cells(1,2) as it's value. The problem with this is that Dictionaries don't know how to compare cells and you will not be able to look up your values based on there key relationships. dictionary.Add Cells(1,1).Value, Cells(1,2) is the correct syntax.

Sub TransferData()
    Dim r As Range, Source As Range
    Dim d As Object
    Set d = CreateObject("Scripting.Dictionary")
    With Worksheets("TMRtoSPIde")
        For Each r In .Range("B2", .Range("B" & .Rows.Count).End(xlUp))
            If Not d.Exists(r.Value) Then d.Add r.Value, r.EntireRow
        Next
    End With

    With Worksheets("RawData")
        For Each r In .Range("B2", .Range("B" & .Rows.Count).End(xlUp))
            If d.Exists(r.Value) Then
                r.EntireRow.Range("K1").Value = d(r.Value).Range("P1").Value
            End If
        Next
    End With

End Sub

这篇关于Visual Basic，VBA数组循环的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！