我无法创建数组，而且我的去重功能也有问题。

13 浏览
0 Comments

我无法创建数组，而且我的去重功能也有问题。

请查看附件以了解我的查询结果（图像中我已经提到了标题以方便您理解，但实际上输出的标题是空白的）。

我的代码只运行了第一个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 '下标超出范围错误
            .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
    '做一些操作
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

enter image description here

0

3 答案

0 Comments

问题的出现原因是数组的定义以及在去除重复项时出现了错误。解决方法是重新定义数组并修改去除重复项的代码。

在定义数组时，使用了ReDim arr(0)，这告诉应用程序将arr定义为一个上界为0的单维数组。由于默认的下界通常是0，这实际上是告诉应用程序为1个对象分配空间，可以通过arr(0)来访问该对象。

如果使用了以下代码ReDim arr(1 to 10)，则会告诉应用程序定义一个上界为10的单维数组，其中有10个对象，第一个对象可以通过arr(1)访问，最后一个对象可以通过arr(10)访问。

下面的代码ReDim arr(9)也会定义一个上界为9的单维数组，其中有10个对象，第一个对象可以通过arr(0)访问，最后一个对象可以通过arr(9)访问（这是基于您没有在VBA中声明默认的下界为1的假设）。

您还可以这样定义一个二维数组：ReDim arr(0 to 5, 0 to 15)，这个数组可以容纳96个项目。但是，要访问它们，您必须使用类似arr(0,4)或arr(2,15)的代码。

作为替代方法，您可以考虑使用字典对象而不是数组。字典对象在去除重复项并压缩列时非常有效。字典对象具有一个.Exists方法，可以通过将值（作为键）传递给该方法来检查字典中是否已存在该值。然后，您可以添加任何新项并忽略重复项。

以下是使用字典对象收集不同值和计数的代码示例：

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

0
0 Comments

原因：问题的出现是因为在创建数组和去重的过程中出现了错误。无法正确创建数组，并且在去重时也出现了问题。

解决方法：根据提供的代码，可以看出使用了两种方法来解决问题，一种是使用数组（Method using arrays/Redim preserve），另一种是不使用数组（Method without using arrays/Redim preserve）。这两种方法都能解决问题，但是具体哪种方法更好需要根据实际情况来决定。还计划尝试使用字典方法来解决问题。

以下是整理后的文章：

非常感谢Jeeped和Mistella对问题进行了深入的解释，并让我意识到了我代码中的漏洞。现在我可以用两种方法来解决这个问题，一种是使用数组，另一种是不使用数组。不能确定哪种方法比另一种更好，但它们都对我有效。我以后还会尝试使用字典方法。

使用数组的方法如下：

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

不使用数组的方法如下：

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

以上就是我根据提供的内容整理出的文章。

0
0 Comments

问题原因：问题出现的原因是在循环的每次迭代中，数组的大小没有正确调整，导致数组越界。

解决方法：在尝试将值放入数组之前，使用ReDim语句进行大小调整，并使用Preserve关键字保留数组中的现有元素。

下面是修复后的代码：

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 '不再出现数组越界
        .Cells(k, GPLLastCol + 2).Value = arr(i)
    End If
Next k

0