Question

vbA找出 数组下标越界

Sub 按钮1_单击()
'

Sheets("2015").Select
Dim xxx()
ReDim Preserve xxx(20)
xxx = Range("b2:f5")
Range("v2:z5") = xxx

Dim i&, a&, d
Set d = CreateObject("scripting.dictionary")

Dim x, y As Variant
ReDim y(35) As Integer
ReDim x(1000) As Integer
y = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35)
Sheets("2015").Cells(19, 20) = y(2)
x = Array(4, 6, 8, 88, 99, 0)
'---------------------------------共几个相同数据
For i = 0 To UBound(y)
d(y(i)) = ""
Next
For i = 0 To UBound(x)
If d.exists(x(i)) Then a = a + 1
Next
MsgBox a
Set d = Nothing
'-----------------------------------------
n = 1
K = 0

For i = LBound(y) To UBound(y)
For j = LBound(xxx) To UBound(xxx)

If xxx(j) = y(i) Then
K = 0
Exit For

Else
K = K + 1
If K = UBound(xxx) + 1 Then
ReDim Preserve d(1 To n)
d(n) = y(i)
n = n + 1
K = 0
End If
End If
Next
Next
MsgBox Join(d, ",")
少定义了数组d 下面这段 错误 不知道怎么改，比较出 不重复的
For i = LBound(y) To UBound(y)
For j = LBound(xxx) To UBound(xxx)

If xxx(j) = y(i) Then
K = 0
Exit For

Else
K = K + 1
If K = UBound(xxx) + 1 Then
ReDim Preserve d(1 To n)
d(n) = y(i)
n = n + 1
K = 0
End If
End If
Next
Next
MsgBox Join(d, ",")

• 你的回答被采纳后将获得：
• 系统奖励15（财富值+成长值）+难题奖励10（财富值+成长值）+提问者悬赏30（财富值+成长值）

Answer 1

Private Sub CommandButton1_Click()

Sheets("2015").Select

Dim xxx(), xx()

q = 0

For i = 2 To 5

For j = 2 To 5

If Cells(i, j) <> "" Then

ReDim Preserve xx(q)

xx(q) = Cells(i, j)

q = q + 1

End If

Next

Next

xxx = Range("b2:f5")

Range("v2:z5") = xxx

Dim d, dd()

Set d = CreateObject("scripting.dictionary")

Dim x, y As Variant

ReDim y(34) As Integer

ReDim x(5) As Integer

y = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35)

x = Array(4, 6, 8, 88, 99, 0)

'---------------------------------共几个相同数据

For i = 0 To UBound(y)

d(y(i)) = ""

Next

For i = 0 To UBound(x)

If d.exists(x(i)) Then a = a + 1

Next

MsgBox a

Set d = Nothing

'------------------------------------找出不同的数据

n = 0

For i = LBound(y) To UBound(y)

If IsError(Application.Find(y(i), Join(xx, ","))) = True Then

ReDim Preserve dd(n)

dd(n) = y(i)

n = n + 1

End If

Next

MsgBox Join(dd, ",")

End Sub

追问

给你追加分吗？