Excel中VBA：创建多个范围变量二维数组（无重复） [英] Excel VBA: Create two-dimensional array from multiple range variables (no duplicates)

问题描述

我有六个变量范围：A_backup，B_backup，C_backup，D_backup，E_backup，F_backup

I have six variable ranges: A_backup, B_backup, C_backup, D_backup, E_backup, F_backup

每个范围变量是行的可变数目（一些具有3，人有5等）

Each range variable is one column with a variable number of rows (some have 3, others have 5, etc.)

我想借此从这些范围每一个细胞，并将它们添加到一个名为Combined_backups一个新的单列阵列。我也想避免增加一个单元格，如果它是一个重复的字符串值到previously添加单元格。

I would like to take each cell from these ranges and add them to a new single column array called Combined_backups. I would also like to avoid adding a cell if it is a duplicate string value to a previously added cell.

下面是我已经试过。运行与Combined_backups.RemoveDuplicates问题。我应该为联合数组的新范围，应用RemoveDuplicates，然后创建一个新的最终数组？此外，什么是要测试我的Combined_backups阵列实际上已经成为我所期待的？阵列的最佳方法

Here's what I've tried. Running into issues with the Combined_backups.RemoveDuplicates. Should I make a new range for the combined array, apply the RemoveDuplicates, then create a new final array? Also, what's the best way to test that my Combined_backups array has actually become the array I was hoping for?

Dim Combined_backups() As Variant

'add A_backup
Dim j As Integer
j = A_backup.Rows.Count

ReDim Preserve Combined_backups(j)

For i = 0 To j - 1
    Combined_backups(i) = A_backup.Item(i + 1)
Next i

'add B_backup
Dim k As Integer
k = B_backup.Rows.Count

ReDim Preserve Combined_backups(j + k)

For i = 0 To k - 1
    Combined_backups(i) = B_backup.Item(i + 1)
Next i

'add C_backup
Dim l As Integer
l = C_backup.Rows.Count

ReDim Preserve Combined_backups(j + k + l)

For i = 0 To l - 1
    Combined_backups(i) = C_backup.Item(i + 1)
Next i

'add D_backup
Dim m As Integer
m = D_backup.Rows.Count

ReDim Preserve Combined_backups(j + k + l + m)

For i = 0 To m - 1
    Combined_backups(i) = D_backup.Item(i + 1)
Next i

'add E_backup
Dim n As Integer
n = E_backup.Rows.Count

ReDim Preserve Combined_backups(j + k + l + m + n)

For i = 0 To n - 1
    Combined_backups(i) = E_backup.Item(i + 1)
Next i

'add F_backup
Dim o As Integer
o = F_backup.Rows.Count

ReDim Preserve Combined_backups(j + k + l + m + n + o)

For i = 0 To o - 1
    Combined_backups(i) = F_backup.Item(i + 1)
Next i

'elminate duplicates from Combined_backups
Combined_backups.RemoveDuplicates

谢谢！

推荐答案

下面是一个使用Collection对象不同的方法。我们首先把一切都变成收集，利用我们的优势其拒绝重复的财产;然后我们把收集对象变成了结果的数组，并将其写回表。这是假设你在不同的阵列被命名范围，而不是Range对象，但你应该能够适应需要：

Here's a different approach using the Collection object. We first put everything into a Collection, using to our advantage its property of rejecting duplicates; then we put the collection object into a "results" array, and write it back to a worksheet. This assumes your various arrays are named ranges and not range objects, but you should be able to adapt as needed:

选项显式

Sub UniqueArray()
    Dim vSrc As Variant
    Dim colStrings As Collection
    Dim vVarRanges As Variant
    Dim vResults() As Variant
    Dim S As String
    Dim I As Long, J As Long, K As Long

vVarRanges = VBA.Array("A_backup", "B_backup", "C_backup", "D_backup", "E_backup", "F_backup")

Set colStrings = New Collection
On Error Resume Next 'So collection will omit any duplicates instead of causing an error
For I = 0 To UBound(vVarRanges)
    vSrc = Range(vVarRanges(I))
    For J = 1 To UBound(vSrc, 1)
        S = vSrc(J, 1)
        If Len(S) > 0 Then _
            colStrings.Add Item:=S, Key:=CStr(S)
    Next J
Next I
On Error GoTo 0

'Now create results array
ReDim vResults(1 To colStrings.Count, 1 To 1)
For I = 1 To colStrings.Count
    vResults(I, 1) = colStrings(I)
Next I

'Write the results someplace

With Worksheets("sheet4").Range("A1").Resize(rowsize:=UBound(vResults))
    .EntireColumn.Clear
    .Value = vResults
End With

End Sub

这篇关于Excel中VBA：创建多个范围变量二维数组（无重复）的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！