我无法创建数组，我的删除重复项也有问题答案

【问题标题】：I am not able create array and there is something wrong with my remove duplicates also我无法创建数组，我的删除重复项也有问题
【发布时间】：2018-04-21 09:52:04
【问题描述】：

请看附件了解我的查询的输出（我在图像中提到了标题以供您理解，实际上，输出的标题是空白的）。

我的代码仅在 k 的第一次迭代中运行，然后在下面提到的行中出现错误“下标超出范围。此外，我的删除重复项没有在代码中提供所需的输出。是因为空格或者我该如何解决这两个问题？

我是第一次使用数组。

Dim MoNameArr
Dim arr()
Dim ColLtrg, ColLtrgp, GPLLastCol, GPLLastRow as Long
i = 0
ReDim arr(0)

With wsg

    For k = 2 To GPLLastRow

        .Cells(k, GPLLastCol + 1).Value = .Cells(k, 2).Value & .Cells(k, 3).Value

        If .Cells(k, 4).Value = .Cells(k, 8).Value And .Cells(k, 4).Value = .Cells(k, 9).Value Then
            i = k - 2
            arr(i) = .Cells(k, 2).Value 'Subscript out of range error
            .Cells(k, GPLLastCol + 2).Value = arr(i)
            ReDim Preserve arr(i)
        End If

    Next k

    ColLtrg = Replace(.Cells(1, GPLLastCol + 2).Address(True, False), "$1", "")

    .Range(ColLtrg & "1:" & ColLtrg & GPLLastRow).RemoveDuplicates Columns:=1, Header:=xlNo
    MoNameArr = .Range("AD1:AD" & GetLastRow(wsg, GPLLastCol + 2))

End With

For Each Item In MoNameArr
    'Do something
Next Item


Public Function GetLastCol(ByVal ws As Worksheet, rowNum As Long) As Long
  With ws
    GetLastCol = .Cells(rowNum, Columns.Count).End(xlToLeft).Column
  End With
End Function

Public Function GetLastRow(ByVal ws As Worksheet, colNum As Long) As Long
  With ws
    GetLastRow = .Cells(Rows.Count, colNum).End(xlUp).Row
  End With
End Function

【问题讨论】：

谁投了反对票，如果您不能提供解决方案，请提供原因。我正在学习 vba，并且第一次遇到数组（无论如何都在做我的第二个作业），我无法通过阅读与数组相关的文章来弄清楚很多东西。
只是想注意：这个声明：Dim ColLtrg, ColLtrgp, GPLLastCol, GPLLastRow as Long 只是将GPLLastRow 声明为Long。其他默认为Variant。

标签： arrays excel range vba

【解决方案1】：

下标超出范围错误很可能来自您如何将数组定义到应用程序。我非常有信心，当您遇到该错误时，i 0.

注意：

当使用ReDim Preserve arr(i) 时，您需要在尝试将变量放入arr(i) 之前声明这个。此外，由于i 基于与单元格引用相关的k，因此您的数组将在您决定保留的值之间产生许多空项目槽。

说明

在这一行：

ReDim arr(0)

您告诉应用程序将arr 定义为上边界为0 的一维数组，因为默认的下边界通常也是0；您实际上是在告诉应用程序为 1 对象定义具有空间的数组。

将通过代码arr(0)

访问

如果您使用了以下行：

ReDim arr(1 to 10)

您会告诉应用程序将数组定义为一维数组，其中有 10 个对象的空间，第一个通过arr(1) 访问，最后一个通过arr(10) 访问。

下一行也将数组定义为一维数组，包含 10 个对象：

ReDim arr(9)

但是，这一次，第一个对象可以通过arr(0) 访问，最后一个对象可以通过arr(9) 访问。（这是基于您尚未在 vba 中声明默认下限应为 1 的假设。）

你可以像这样定义一个二维数组：

ReDim arr(0 to 5, 0 to 15)

这个数组将包含 96 个项目。但是，要访问它们，您必须使用 arr(0,4) 或 arr(2,15) 之类的代码。

备选方案

如果我可以推荐一种替代方法，您是否考虑过使用字典对象而不是数组？

由于我不知道您对数据所做的一切，这可能不是最佳解决方案。但是，如果您的主要目标是从列中删除重复值并压缩列，我认为字典应该可以很好地工作。

stackoverflow 上的这个 Q/A 提供了一些关于字典、集合和数组的很好的基本信息。

我考虑字典的主要原因是因为字典对象有一个.Exists 方法，您可以在其中传递一个值（作为键）并查看字典是否已经有了它。然后您可以添加任何新项目并忽略重复的项目。

假设dict 是一个字典对象，rng 是您正在检查的循环变量单元格/范围对象，您可以使用以下代码来收集不同值和计数的列表：

For each rng in SomeRangeVariable
    With dict
        If .Exists(rng.Value) Then
            .Items(rng.Value) = .Items(rng.Value) + 1
        Else
            .Add Key:=rng.Value, Item:=1
        End If
    End With
Next rng

【讨论】：

【解决方案2】：

您使用单个元素实例化从零开始的一维数组arr；例如arr(0 to 0).

在循环的第一次迭代中，k 是 2，i = k - 2 所以i 是零。如果条件满足，数组中有空间存放.Cells(k, 2) 值。

ReDim 语句在这里什么都不做，因为i 为零，而ubound(arr) 已经为零。

在下一次迭代中，直到满足条件为止，ubound(arr) 仍然为零，但 k 已经增长，并且由于 i 基于 k，它也会增长。任何将.Cells(k, 2) 值放入arr 的i 位置的尝试都将导致“下标超出范围”。

解决方案：在尝试填充数组之前使用 Preserve 进行 Redim。

For k = 2 To GPLLastRow
    .Cells(k, GPLLastCol + 1).Value = .Cells(k, 2).Value & .Cells(k, 3).Value
    If .Cells(k, 4).Value = .Cells(k, 8).Value And .Cells(k, 4).Value = .Cells(k, 9).Value Then
        i = k - 2
        ReDim Preserve arr(i)
        arr(i) = .Cells(k, 2).Value 'Subscript not out of range anymore
        .Cells(k, GPLLastCol + 2).Value = arr(i)
    End If
Next k

【讨论】：

【解决方案3】：

非常感谢 Jeeped 和 Mistella 的深入解释，让我意识到我的代码中存在漏洞。我现在可以使用 2 种方法来做到这一点。一个带数组，一个不带数组。不能说其中是否有人比另一个更好，但它们都对我有用。我稍后也会尝试字典方法。

'使用数组的方法/Redim 保存

i = 0
With wsg
    For k = 2 To GPLLastRow
    On Error Resume Next 'For handling #N/A values
        .Cells(k, GPLLastCol + 1).Value = .Cells(k, 2).Value & .Cells(k, 3).Value
        If .Cells(k, 4).Value = .Cells(k, 8).Value And .Cells(k, 4).Value = .Cells(k, 9).Value Then
            ReDim Preserve arr(i)
            arr(i) = .Cells(k, 2).Value 'Subscript not out of range anymore
            .Cells(i + 1, GPLLastCol + 2).Value = arr(i)
            i = i + 1
        End If
    On Error GoTo 0
    Next k

    ColLtrgp = Replace(.Cells(1, GPLLastCol + 1).Address(True, False), "$1", "")
    ColLtrg = Replace(.Cells(1, GPLLastCol + 2).Address(True, False), "$1", "")

    .Range(ColLtrg & "1:" & ColLtrg & GetLastRow(wsg, GPLLastCol + 2)).RemoveDuplicates Columns:=1, Header:=xlNo
    MoNameArr = .Range(ColLtrg & "1:" & ColLtrg & GetLastRow(wsg, GPLLastCol + 2))
End With

'不使用数组的方法/Redim保留

i = 1
With wsg
    For k = 2 To GPLLastRow
    On Error Resume Next
        .Cells(k, GPLLastCol + 1).Value = .Cells(k, 2).Value & .Cells(k, 3).Value
        If .Cells(k, 4).Value = .Cells(k, 8).Value And .Cells(k, 4).Value = .Cells(k, 9).Value Then
            .Cells(i, GPLLastCol + 2).Value = .Cells(k, 2).Value
            i = i + 1
        End If
    On Error GoTo 0
    Next k

    ColLtrgp = Replace(.Cells(1, GPLLastCol + 1).Address(True, False), "$1", "")
    ColLtrg = Replace(.Cells(1, GPLLastCol + 2).Address(True, False), "$1", "")

    .Range(ColLtrg & "1:" & ColLtrg & GetLastRow(wsg, GPLLastCol + 2)).RemoveDuplicates Columns:=1, Header:=xlNo
    MoNameArr = .Range(ColLtrg & "1:" & ColLtrg & GetLastRow(wsg, GPLLastCol + 2))
End With

【讨论】：