Redim数组
我想从两个数组中删除重复的x和它们相关的y,但是我收到了这个错误:数组已经划分了维度!
我的代码有什么问题?
假设我有这些值,并且我想删除重复的第三行[(X2)和Y(2)]:
Dim x(0到3)为Double,y(0到3)为Double x(0)= 0.29
Y(0)= 0.89
x(1)= 0.34
Y(1)= 0.44
x(2)= 0.29
Y(2)= 0.89
x代码0]
**** Hidden Message ***** 您无法
在多个数组中重新绘制第一个维度,只能重新创建第二个
数组 以下是如何在删除重复后重新创建新数组的方法
:
'make sure you checked in Tools->Options->General->Error trapping->'Break on Unhandled Errors'
Sub TestRemove_Dupes()
Dim x(0 To 3) As Double, y(0 To 3) As Double
x(0) = 0.29
y(0) = 0.89
x(1) = 0.34
y(1) = 0.44
x(2) = 0.29
y(2) = 0.89
x(3) = 0.12
y(3) = 0.86
Dim coll As New Collection
Dim i, j
Dim itm(0 To 1)
For i = 0 To UBound(x)
itm(0) = x(i): itm(1) = y(i)
On Error Resume Next
coll.Add itm, CStr(x(i)) & CStr(y(i))
Next
ReDim ar(0 To coll.Count - 1, 0 To 1)
'colllection items starts from 1
For i = 1 To coll.Count
ar(i - 1, 0) = coll.item(i)(0): ar(i - 1, 1) = coll.item(i)(1)
Next
For i = 0 To UBound(ar)
Debug.Print ar(i, 0) & " | " & ar(i, 1)
Next
End Sub
嗨,菲索。感谢您高效的解决方案。但我很抱歉反应太晚了。我有点忙,有一些事情要做<真诚地,罗伯特 NP
祝你有美好的一天 或者,您可以在主 Sub(调用“Remove_Duplicate”Sub 的子集)中声明没有维度的向量,并立即使用初始已知维度重新填充它们(在此阶段不需要“保留”关键字)。然后在移动值循环完成后,使用 Sub 内的“保留”关键字再次重新标记它们。就像 follows
Sub Main()
Dim X() As Double, Y() As Double
ReDim X(0 To 3)
ReDim Y(0 To 3)
X(0) = 0.29
Y(0) = 0.89
X(1) = 0.34
Y(1) = 0.44
X(2) = 0.29
Y(2) = 0.89
X(3) = 0.12
Y(3) = 0.86
Call Remove_Duplicate(X, Y, 2)
End Sub
Private Sub Remove_Duplicate(X() As Double, Y() As Double, MyIndex As Long)
Dim i As Long
Dim UbX As Integer
UbX = UBound(X) ' we'll assume the same dimension for Y()
For i = MyIndex + 1 To UbX
X(i - 1) = X(i)
Y(i - 1) = Y(i)
Next
ReDim Preserve Y(UbX - 1)
ReDim Preserve X(UbX - 1)
End Sub
它肯定不如 Fixo 的建议那么有趣(他的知识总是让我感到震惊),也不知道效率是否更低。另一方面,它更短,这总是吸引我。
再见 好照片,我喜欢
致意 鼓掌RICVBA,非常好的技术
当然,我今晚会用它。
谢谢,祝您愉快...
页:
[1]