[已解决]function 返回数组问题

ebbe

我想从Arr数组中的m列查找一些和sTxt相同的数，并将该数所在数组中的行数返回另外一个数组中，储存起来。

我写的代码如下：

Private Sub commandbutton1_Click()
On Error Resume Next
Dim Arr()
Dim m As Integer, sTxt As String
m=1
sTxt="希望"
LastRow = Sheets("sheet1").Cells(Rows.Count, i).End(xlUp).Row
Arr = Sheets("sheet1").Range("A1:E" & LastRow)
Call GetValue(m, sTxt, Arr())
End Sub


Function GetValue(i As Integer, sTr As String, Ar() )
dim Ar1()
For j = 1 To UBound(Arr)
    If sTr Like Ar(j, i) Then
       j = j + 1
        ReDim Preserve Ar1(n)
         Ar1(n) = j
    End If
Next j
GetValue = Ar1
End Function


这些代码有问题：

如果我不定义dim Arr(),那么就弹出来对话框说，类型不匹配：缺少数组或用户自定义类型。
如果我定义了dim Arr()，那么Arr()就如法将单元格的内容放进数组中去，请问，代码是哪里出现了问题，该如何修改？
非常感谢

最佳答案

月排行榜 / 总排行榜

香川群子

2013-11-9 00:26

你这代码错误很多、很多，几乎无法运行。


不过就你出错的原因来说，倒是很简单：
Dim arr() 以后arr就会是一个数组变量而无法进行单元格区域赋值了（只有Variant变量可以进行赋值）

解决办法是，去掉所有括号，不事先定义为数组变量即可。


Private Sub CommandButton1_Click()
    On Error Resume Next
    Dim Arr    Dim m As Integer, sTxt As String
    m = 1
    sTxt = "希望"
    LastRow = Sheets("sheet1").Cells(Rows.Count, i).End(xlUp).Row
    Arr = Sheets("sheet1").Range("A1:E" & LastRow)
    Call GetValue(m, sTxt, Arr)
End Sub

蓝色是改过的，红色是有错误的部分……因为不知道你的思路，无法帮你修改。

Function GetValue(i As Integer, str As String, Ar)
Dim Ar1()
For j = 1 To UBound(Ar)
    If str Like Ar(j, i) Then
       j = j + 1
        ReDim Preserve Ar1(n)
         Ar1(n) = j
    End If
Next j
GetValue = Ar1
End Function


红色部分变量没有赋值，所以代码无法正常工作。呵呵。

跳转到最佳答案楼层

那么的帅

提供数据附件，以便于测试

ebbe

那么的帅 发表于 2013-11-8 23:09
提供数据附件，以便于测试

已经附上代码，请测试。谢谢！

那么的帅

ebbe 发表于 2013-11-8 23:17
已经附上代码，请测试。谢谢！

看错。

ebbe

那么的帅 发表于 2013-11-8 23:40
看错。

啥意思？

香川群子

你这代码错误很多、很多，几乎无法运行。


不过就你出错的原因来说，倒是很简单：
Dim arr() 以后arr就会是一个数组变量而无法进行单元格区域赋值了（只有Variant变量可以进行赋值）

解决办法是，去掉所有括号，不事先定义为数组变量即可。


Private Sub CommandButton1_Click()
    On Error Resume Next
    Dim Arr    Dim m As Integer, sTxt As String
    m = 1
    sTxt = "希望"
    LastRow = Sheets("sheet1").Cells(Rows.Count, i).End(xlUp).Row
    Arr = Sheets("sheet1").Range("A1:E" & LastRow)
    Call GetValue(m, sTxt, Arr)
End Sub

蓝色是改过的，红色是有错误的部分……因为不知道你的思路，无法帮你修改。

Function GetValue(i As Integer, str As String, Ar)
Dim Ar1()
For j = 1 To UBound(Ar)
    If str Like Ar(j, i) Then
       j = j + 1
        ReDim Preserve Ar1(n)
         Ar1(n) = j
    End If
Next j
GetValue = Ar1
End Function


红色部分变量没有赋值，所以代码无法正常工作。呵呵。

ebbe

香川群子 发表于 2013-11-9 00:26
你这代码错误很多、很多，几乎无法运行。

确实，我为了让大家好懂我的程序，我在原程序上做了简单的修改，你 提出来的很正确。我按照你做的，修改了一下代码

Private Sub CommandButton1_Click()
On Error Resume Next
Dim Arr
Dim m As Integer, sTxt As String
m = 1
sTxt = "*希望*"
LastRow = Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Arr = Sheets("sheet1").Range("A1:E" & LastRow)
Call GetValue(m, sTxt, Arr)

End Sub


Option Base 1
Function GetValue(i As Integer, str As String, Ar)
Dim Ar1()
n = 1
For j = 1 To UBound(Ar)
    If Ar(j, i) Like str Then
        ReDim Preserve Ar1(n)
         Ar1(n) = j
         n = n + 1
    End If
Next j
GetValue = Ar1
End Function


这个程序运行无错误，并且是我想要的结果。。。非常非常的感谢

ebbe

香川群子 发表于 2013-11-9 00:26
你这代码错误很多、很多，几乎无法运行。

又出现问题了，我想将得到的getvalue数组返回到过程中去。怎么把数值传过去？
谢谢！

我会了

fffox

GetValue是个函数，你用一个变量=GetValue就可以了

ebbe

fffox 发表于 2013-11-9 10:25
GetValue是个函数，不能用Call，你用一个变量=GetValue就可以了

Function GetValue(i As Integer, str As String, Ar)

改为Function GetValue(i As Integer, str As String, Ar) as integer()就OK了