更新一个大数组中的特定值，它们匹配一个辅助数组（比如一个vlookup）

我一直被委托在Excel中编写一个“简单”的macros来执行下面的任务，我可以用VLOOKUP做比较简单的工作，但是由于数据的大小可能会在某些情况下花费一天的时间，而且会完全锁住电脑。

我有一个.csv与各种标题，我需要询问，以查找和replace这些列中以“_flag”结尾的列中的值。

“标志”（用于标识数据的置信度）已更新，所有较旧的数据都需要相应更新。

我有我所说的“FlagMap”，它列出了旧标志，相应的新标志应该作为一个单独的表格。

通常在Excel中我有一个工作表（命名的范围）与FlagMap和另一个选项卡上的CSV，并放在列旁边手动虚拟列来改变和运行一个VLOOKUP – 做了一些较小的数据集，但给了我必须做的事情我会在完成之前退休（有些人有20个“旗帜”（共40列）和7万行）。

我已经制定了这个过程，但是真的被编码困住了。

以“_flag”结尾的Find列的整个循环如果True通过基于源数据中的单元= FlagMap（COL1）中的一个标志将其replace为FlagMap（COL2）值的vlookup样式代码循环更改End Change Loop Next Column

关键之一是我可以用原始数据replace空白（标志）（通过在FlagMap数组中指定一个空白条目和相应的标志）。

我的代码是一个完整的混乱，因为我试图一点一点地构build它（通过录制macros等。正在使用filter的列）。

代码如下：虽然似乎没有做任何事情; 伤脑筋…. Sub FlagUpdate_v00（）

Dim wsDATA As Worksheet 'original data to be updated Dim wsFLAG As Worksheet 'Flag mapping lookup sheet Dim rFLAGMAP As Range 'Flag mapping range n ROWs & 2 COLs(no headers) Dim rDATA As Range 'Data to update Dim i As Long, j As Long, n As Long 'Loop counters Dim FlagLRow As Long, DataLRow As Long 'last row numbers of corresponding data tables Dim FlagArray, DataArray, TempArray() As String 'lookup values Set wsDATA = ThisWorkbook.Sheets("TEST") 'assigns location of data Set wsFLAG = ThisWorkbook.Sheets("FlagMap") 'assigns location of flags 'lastrow = Cells.SpecialCells(xlCellTypeLastCell).Row 'FlagLRow = wsFLAG.Cells(Rows.Count, 1).End(x1Up).Row 'Sets number of rows upper bound of loop *NOT WORKING 'DataLRow = wsDATA.Cells(Rows.Count, 1).End(x1Up).Row 'Sets number of rows upper bound of loop *NOT WORKING FlagLRow = wsFLAG.Cells.SpecialCells(xlCellTypeLastCell).Row 'Sets number of rows upper bound of loop DataLRow = wsDATA.Cells.SpecialCells(xlCellTypeLastCell).Row 'Sets number of rows upper bound of loop Set rFLAGMAP = wsFLAG.Range("A2:A" & FlagLRow) 'sets range of flags to avoiding column header 'this will need to be within a loop to only select range of those columns ending "_Flag" 'Set rDATA = wsDATA.Range(ColLoopRef & "2:A" & DataLRow) 'set range to update Set rDATA = wsDATA.Range("F2:F" & DataLRow) 'test data only looking at one small column of data FlagArray = rFLAGMAP.Value 'set contents of array DataArray = rDATA.Value 'set contents of array 'Loop to replace For i = LBound(DataArray) To UBound(DataArray) 'start end values of i loop (Original Flag) For j = LBound(FlagArray) To UBound(FlagArray) 'start end values of j loop (FlagMap) If DataArray(i, 1) = FlagArray(j, 1) Then 'if Original Data Flag matches the value in the FlagMap Set DataArray(i, 1) = FlagArray(j, 2) 'replace it with that from column 2 End If 'all flags should be Mapped hence always finds one 'only issue may be blanks!! Next j 'loop through the MAPPEDFLAG list (ie. a vlookup) 1st Next i 'move on to the next DATA flag to be re-flagged End Sub 

感谢@stucharo突出显示了我具体的例子，如下所示：

当前以CSV格式设置的数据

  h1 h2 h3_flag h4 h5_flag h6 ------------------------------------------------------------- val1 val2 val3 val4 val5 val6 val2 val3 val4 val5 val6 val1 val3 val4 val5 val6 val1 val2 val4 val5 val6 val1 val2 val3 val5 val6 val1 val2 val3 val4 val6 val1 val2 val3 val4 val5 

标志映射表

  flag alt. -------------------- val1 vala val2 valb val3 valc val4 vald val5 vale val6 valf 

产量

  h1 h2 h3_flag h4 h5_flag h6 ------------------------------------------------------------- val1 val2 valc val4 vale val6 val2 val3 vald val5 valf val1 val3 val4 vale val6 vala val2 val4 val5 valf val1 valb val3 val5 val6 vala val2 valc val4 val6 val1 valb val3 vald val5 

Answer 1

下面是我为类似的东西而开发的一段代码，但是我已经调整了一下以适应你的问题。 它可能需要一些整理，因为我没有访问您的文件来testing它：

 Sub Flags() 'Assuming your flag map is in a 2 column range in a worksheet 'you can create an array then add it to a collection 'so you can access each entry in col2 by the key from col1 Dim fMap() As Variant Dim FlagMap As New Collection fMap = Range("A1:B6") 'range where FlagMap stored Dim i As Integer 'We can reuse this in other counters.... For i = LBound(fMap) To UBound(fMap) FlagMap.Add CStr(fMap(i, 2)), CStr(fMap(i, 1)) 'FlagMap range has "Key" field 1st - assign to Collection correctly Next i 'Create a FileSystemObject to work with your csv's Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") 'Create a file object to contain your original csv Dim ifil As Object Set ifil = fso.GetFile("C:\completepath\myinfile.csv") 'Create a textstream from the input csv file Dim its As Object Set its = ifil.OpenAsTextStream() 'We can also output this back into a new csv by 'creating a textstream to let us write to a new file Dim ots As Object Set ots = fso.CreateTextFile("C:\completepath\myoutfile.csv") 'We'll also need a string variable to send to this stream Dim oStr As String 'Create a counter to keep track of lines through your 'input textstream Dim lineCounter As Integer lineCounter = 0 'You can split each line into an array delimited by "," using 'the "Split" function so we need an array variable to hold this Dim lineArray() As String 'Because this steps through row wise, we also need an 'collection to hold references to the columns of interest 'and a variant to access them again Dim cols As New Collection Dim col as Variant 'Continue a loop until you reach the end of your textstream 'ie the end of your input csv file Do While Not its.AtEndOfStream 'Increment your line counter lineCounter = lineCounter + 1 lineArray = Split(its.ReadLine, ",") 'If you are on the first row, find all the interesting columns If lineCounter = 1 Then ' assuming the headings are on row 1 For i = LBound(lineArray) To UBound(lineArray) 'If we find a heading ending in "_flag" then store its 'column number in the cols collection. If Right(lineArray(i), 5) = "_flag" Then cols.Add i 'Add ref of where heading "_flag" is to limit lookup just to those areas and not the whole dataset End If Next i 'If it's not the first row then process the data as normal Else 'Just look at the columns of interest For Each col In cols 'Replace the value in that column with the corresponding 'value in the FlagMap lineArray(CInt(col)) = FlagMap(lineArray(CInt(col))) 'this is the lookup in the collection based on the "key" Next col End If 'Now print the line back out to your new csv file oStr = "" For i = LBound(lineArray) To UBound(lineArray) oStr = oStr + lineArray(i) & "," Next i oStr = Left(oStr, Len(oStr) - 1) ots.WriteLine (oStr) Loop 'Close the textstreams its.Close ots.Close End Sub 

TextStream将允许您读取和写入VBA中的.csv文件，而无需在Excel中打开它们。 Collections允许您开发'key':{value}关系，这听起来有点像您的FlagMap。