VBA - 从另一个数组创建一个数组

Question

如果可能的话，我想知道如何做到这一点。我已将 arrayC(26) 定义为：

Dim arrayC(26) As String
arrayC(26) = "A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z"
Dim i As Integer 'Position in the arrayC(26)
i = 1

基于另一个单元格的值，如果它的值为 3，我想从 A 转到 C。如果它的值为 5，我想从 A 转到 E。依此类推。

Dim j As Integer
j = 1
ReDim arrayCont(j) As Variant

让我们假设它从 A 到 C。所以，我希望在 arrayCont(j) 中我有以下值“A，B，C”。然后我会去 Cells(8,"C") 检查它是否等于 arrayCont(j) 中的值。如果是这样，我想从 arrayCont(j) 中删除该值。例如，考虑 Cells(8,"C") = "B"。然后我的 arrayCont(j) 将是“A，C”。我怎样才能做到这一点？

我创建的代码是：

Do While p <= sh1.Range("D6").Value
 For p = 1 To sh1.Cells(6, "D").Value
  If sh3.Cells(8, "C").Value = arrayC(p) Then
   arrayCont(j) = arrayCont(j)
  Else
   arrayCont(j) = arrayC(p)
  End If
 Next p
 j = j + 1
Loop

提前谢谢你。

Answer 1

首先，为了将括号内的所有字母添加到数组中的元素，数组需要是动态的 (Dim arrayC As...)，而不是静态的 (Dim arrayC(26) As...)。另外，要么使用Split，要么需要在括号内的每个元素前后添加"。

第二，为了在复制的数组（arrayCont）中找到“C8”中的值，也就是Redim直到i（=3），我们使用Application.Match 查找数组内匹配元素的索引。如果存在“匹配”，则我们从数组中删除该元素。

第三我正在使用一个名为 "DeleteElementAt" 的Sub，它从数组中删除某个元素，具体取决于您要删除的数组的索引。

---

我的代码（已测试）

Option Explicit

Sub SubArrayfromArray()

Dim arrayC As Variant
Dim i As Integer 'Position in the arrayC(26)
Dim arrayCont As Variant

' this is the way to put all the strings inside the brackets in an array (type Variant) in one line of code
arrayC = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
i = 3 ' i is the value of another worksheet cell

' copy original dynamic array to destination dynamic array
arrayCont = arrayC

' redim the copied array up to 3 (from 0 to 2)
ReDim Preserve arrayCont(0 To i - 1)

' value in Range C8  >> if "B" was found inside the arrayCont >> remove it from the array
If Not IsError(Application.Match(Range("C8").Value, arrayCont, 0)) Then
    Call DeleteElementAt(Application.Match(Range("C8").Value, arrayCont, 0) - 1, arrayCont)
End If
' for debug only
'For i = LBound(arrayCont) To UBound(arrayCont)
'    MsgBox "Array element " & i & " Value is " & arrayCont(i)
'Next i

' Edit 1: place arrayCont result in Cells(9, 3) >> Range("C9")
Range("C9").Resize(UBound(arrayCont) + 1, 1).Value = Application.Transpose(arrayCont)

End Sub

Sub DeleteElementAt 代码

Public Sub DeleteElementAt(ByVal ArrIndex As Integer, ByRef myArr As Variant)

' this sub removes a certain element from the array, then it shrinks the size of the array by 1    
Dim i As Integer

' move all element back one position
For i = ArrIndex + 1 To UBound(myArr)
    myArr(i - 1) = myArr(i)
Next

' shrink the array by one, removing the last one
ReDim Preserve myArr(UBound(myArr) - 1)

End Sub