我的数组无法替换和偏移值VBA [英] My array fails to replace and offset values VBA
问题描述
MyFile = Dir(MyFolder)
Do While MyFile <> ""
Application.StatusBar = "Opening" & MyFile
Set wbk = Workbooks.Open(MyFolder & MyFile, True, True)
bFound = False
For Each ws In wbk.Sheets
If ws.Name = "Sheet 1" Then
Range("B2").Select 'This gives us the first cell
Do Until IsEmpty(ActiveCell)
For i = LBound(arr, 1) To UBound(arr, 1)
For j = LBound(arr, 2) To UBound(arr, 2)
If arr(i, j) <> "" And arr(i, j) <> ActiveCell.Value Then
For k = UBound(arr, 2) To j + 1 Step -1
arr(k, i) = arr(k - 1, i)
Next k
arr(i, j) = ActiveCell.Value
End If
If arr(i, j) = "" Then
arr(i, j) = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
End If
If arr(i, j) = ActiveCell.Value Then
ActiveCell.Offset(1, 0).Select
End If
If ActiveCell.Value = "" Then
Exit For
End If
Next j
If ActiveCell.Value = "" Then
Exit For
End If
Next i
Loop
End If
Next
Loop
如您在图像中看到的，我有一个由4个元素组成的数组，我通过遍历工作表的第二列(称为"Sheet 1")将这些元素放入数组中.取自名为"food.xlsx"的工作簿.在用户通过选择选择的文件夹中.在阵列将表"Sheet 1"的第2列中的每个元素放置之后.然后将这些元素放到自身的第1列中，我们的数组如下图所示:
As you can see in the image I have an array of 4 elements, I got these elements into the array by iterating through the second column of a worksheet called "Sheet 1" from a workbook called "food.xlsx" in a folder that the user choses by selection. after the array places every element from column 2 of sheet "Sheet 1" and then places these elements into column 1 of itself, our array looks like the following image...
然后，我们转到下一个名为"food2.xlsx"的工作簿.它位于同一文件夹中.我们看一下food2.xlsx的第2列.food2.xlsx的第2列与food.xlsx的第2列在完全相同的行中具有完全相同的值.唯一的区别是，在food2.xlsx中第2列的第3行中，值"vanilla"而不是"chocolate".我想做的是将香草"放置在在阵列的位置上，巧克力"位于其中.当前位于，它将位于arr(1,3).然后我想要的是推巧克力"饼干.而其下的所有其他值则下降一个位置.因此，该数组应以..
We then move on to the next workbook called "food2.xlsx" which is located in the same folder. We look at column 2 of food2.xlsx. Column 2 of food2.xlsx has the exact same values at the exact same rows as column 2 of food.xlsx. The only difference is that in row 3 of column 2 in food2.xlsx, instead of having a value of "chocolate", there is a value of "vanilla". What am I trying to do is place "vanilla" in the location of the array where "chocolate" is currently located, this would be at arr(1,3). Then what I want is to push "chocolate" and every other value under it down one spot. So the array should end up like..
代码中未完成工作的部分是以"If arr(i，j)<>开头的if语句."而arr(i，j)<ActiveCell.Value然后"
The part of the code that is NOT doing its job is the if statement that starts with "If arr(i, j) <> "" And arr(i, j) <> ActiveCell.Value Then"
重要提示:我需要使用它来处理任何新遇到的价值，而不仅仅是香草
IMPORTANT: I need this to work for any new encountered value, not just vanilla
推荐答案
Unrelated note: I prefer the FileSystemObject API over the VBA Dir function; which you can use by adding a reference (Tools -> References...) to the Microsoft Scripting Runtime library.
我建议使用断开连接的ADO记录集.记录集通常与从数据库或其他数据源中提取数据相关；但是我们可以构造并填充自己的数据，并使用记录集的内置排序功能.这使我们不必担心在数组内来回移动元素，甚至从插入新元素的正确位置上也不必担心.
I would suggest using a disconnected ADO recordset. Recordsets are commonly associated with pulling data from databases or other data sources; but we can construct and fill our own, and use the recordset's built-in sorting capabilities. This frees us from worrying about shifting elements back and forth within the array, or even from the proper position in which to insert the new element.
向 Microsoft ActiveX数据对象添加参考(工具-> 参考... )；选择最新版本-通常为 6.1 .
Add a reference (Tools -> References...) to Microsoft ActiveX Data Objects; choose the latest version -- usually 6.1.
然后，您可能会获得类似以下的代码:
Then, you could have code like the following:
' Define the shape of the recordset
Dim rs As New ADODB.Recordset
rs.Fields.Append "Entry", adVarChar, 100
rs.Fields.Append "FileIndex", adTinyInt
rs.Fields.Append "RowIndex", adTinyInt
rs.Open
' Loop over the files, and populate the recordset
MyFile = Dir(MyFolder)
Do While MyFile <> ""
Dim fileIndex As Integer
Application.StatusBar = "Opening" & MyFile
Set wbk = Workbooks.Open(MyFolder & MyFile, True, True)
Dim data As Variant
data = wbk.Worksheets("Sheet 1").UsedRange.Columns(2).Value
Dim ubnd As Integer
ubnd = UBound(data, 1)
Dim rowIndex As Integer
For rowIndex = 1 To ubnd
Dim entry As String
entry = data(rowIndex, 1)
rs.Find "Entry='" & entry & "'"
If rs.BOF Or rs.EOF Then ' record hasn't been found or recordset is empty
rs.AddNew _
Array("Entry", "RowIndex", "FileIndex"), _
Array(entry, rowIndex, fileIndex)
rs.Update
End If
rs.MoveFirst
Next
wbk.Close
MyFile = Dir
fileIndex = fileIndex + 1
Loop
' Specify the sort order, first by the row within the file, then by the order in which
' the file was processed
rs.Sort = "RowIndex,FileIndex"
' Iterate over the data, and print it to the Immediate pane
rs.MoveFirst
Do Until rs.EOF
Debug.Print rs("Entry")
Loop
请注意，元素首先按照它们在各自文件中的出现顺序进行排序，然后再按照文件处理的顺序进行排序.
Note that the elements are sorted first by the order in which they appear in their respective files, then by the order in which the file was processed.
Excel
- 工作簿对象 — 工作表属性和收藏， 工作表对象 — <一个href ="https://docs.microsoft.com/office/vba/api/excel.worksheet.usedrange" rel ="nofollow noreferrer"> UsedRange 属性
- 范围对象 — 列 和 值 属性
- Workbook object — Worksheets property and collection, Close method
- Worksheet object — UsedRange property
- Range object — Columns and Value properties
VBA
ADO
