将数组用于来自多个工作表/ VBA的唯一副本

我一直在研究一个总结我的工作簿中多个工作表的数据的macros。 为了知道在我的汇总表中使用哪些列，我需要首先从表格的第一列中提取所有的唯一值。

这个想法是，它会循环遍历工作表并定义一个范围，然后它将遍历范围中的每个单元格，检查该单元格的值是否已经在数组中，如果没有复制并粘贴，并将其添加到arrays。

不幸的是，我得到一个错误“有效区域以外的索引”的行应该将单元格值添加到数组。

ReDim Preserve uniqueVal(1 To UBound(uniqueVal) + 1) As Variant 

我从问题https://superuser.com/questions/808798/excel-vba-adding-an-element-to-the-end-of-an-array拿了那个特定的代码。

这里是整个代码供参考。

 Private Sub CommandButton24_Click() Dim xSheet As Worksheet Dim DestSh As Worksheet Dim Last As Long Dim copyRng As Range Dim destRng As Range Dim cRange As Range Dim c As Range Dim uniqueVal() As Variant With Application .ScreenUpdating = False .EnableEvents = False End With 'Delete the summary worksheet if it exists. Application.DisplayAlerts = False On Error Resume Next ActiveWorkbook.Worksheets("Summary").Delete On Error GoTo 0 Application.DisplayAlerts = True ' Add a worksheet with the name "Summary" Set DestSh = ActiveWorkbook.Worksheets.Add DestSh.Name = "Summary" Set destRng = DestSh.Range("A1") 'Define inital array values uniqueVal = Array("Account by Type", "Total") ' Loop through all worksheets and copy the data to the ' summary worksheet. For Each xSheet In ActiveWorkbook.Worksheets If InStr(1, xSheet.Name, "ACCOUNT") And xSheet.Range("B1") <> "No Summary Available" Then _ Set copyRng = xSheet.Range("A:A") For Each c In copyRng.SpecialCells(xlCellTypeVisible) If Len(c) <> 0 And Not ISIN(c, uniqueVal) Then _ 'Copy to destination Range c.Copy destRng 'move destination Range Set destRng = destRng.Offset(0, 1) 'change / adjust the size of array ReDim Preserve uniqueVal(1 To UBound(uniqueVal) + 1) As Variant 'add value on the end of the array uniqueVal(UBound(uniqueVal)) = c.Value End If Next c End If Next xSheet ExitTheSub: Application.Goto DestSh.Cells(1) With Application .ScreenUpdating = True .EnableEvents = True End With End Sub 

Answer 1

默认情况下，Excel VBA中的数组以索引0开始，而不是索引1 。 你可以通过检查你的数组内容来testing：你的第一个string"Account by Type"应该是uniqueval(0)而不是uniqueval(1) 。

两种方法来解决这个问题：

1. 添加Option Base 1到您的模块或顶部

2. 更改ReDim Preserve uniqueval(1 To UBound(uniqueval) + 1)到ReDim Preserve uniqueval(0 To UBound(uniqueval) + 1)

这取决于你select哪一个，但后者更清洁，因为你不必在模块级别上摆弄arrays选项。

正如我所看到的，你实际上并没有使用数组的内容。 如果你稍后做，只是循环For i = LBound(uniqueval) To UBound(uniqueval) – 在这种情况下，它与你去的选项无关。

Answer 2

在第一个循环uniqueVal没有Ubound。 这就是为什么它失败。 所以，你应该先把它重新设为Redim uniqueVal（1 to 1），然后写入Ubound并在之后增加大小。 这总会让你在上面留下一个空白的元素，最后你可以删除它。 更好的（因为它运行得更快）是将uniqueVal设置为可能的最大值，然后用计数器设置当前索引，如i = i + 1，并在结尾处执行Redim Preserve uniqueVal（i）所有未使用的元素。

代码行末尾的下划线表示该行在逻辑上位于下一行。 例如，

 If 1 <> 2 Then _ Debug.Print "All is well" 

这与If 1 <> 2 Then Debug.Print "All is well"然而，观察到，没有End If 。 如果有多个命令跟着Then你就必须使用End If ，例如，

 If 1 <> 2 Then Debug.Print "All is well" A = 3 End If 

这里， If和End If之间的所有内容只在1 <> 2执行。 If Len(c) <> 0 And Not ISIN(c, uniqueVal) Then _就是这种情况。 一旦UBound的错误被治愈，这个将会停止你的代码运行。 Then删除下划线。