Question

我试图在不同的子例程之间传递动态数组DArrayRight（），从DefineArrayRight（将创建Array）到CellRightMarked（将对工作表执行操作）。不幸的是我尝试没有成功。有什么建议么？

非常感谢

Teacher

并传递到此子例程：

Sub DefineArrayRight()
Dim DArrayRight() As Variant ' dynamic array
Dim xrow As Long, i As Long
i = 0
xrow = 2

ReDim DArrayRight(0) ' resize the array to hold 1 string

 Do Until ThisWorkbook.Sheets("Sheet1").Cells(xrow, 2).Value = ""
  If ThisWorkbook.Sheets("Sheet1").Cells(xrow, 3).Value = "Right" Then
    DArrayRight(i) = ThisWorkbook.Sheets("Sheet1").Cells(xrow, 2).Value 'add the value in the array
    i = i + 1 ' increase the upper bound of the array
    ReDim Preserve DArrayRight(i) ' preserve the array
  End If
  xrow = xrow + 1
 Loop
ReDim Preserve DArrayRight(i - 1) ' delete the empty array
End Sub

Answer 1

VBA提供了您想要对子对象执行的功能。这是您需要的功能。它基于您的意见，并提出了改进建议。

Function ArrayRight() As Variant

    Dim Fun() As Variant                    ' function return value
    Dim Ws As Worksheet                     ' easier to refer to
    Dim R As Long, Rl As Long               ' row, last row
    Dim i As Long

    ' i = 0                                 ' i is already zero
    ' R = 2                                 ' defined in the For .. Next loop
    ' ReDim DArrayRight(0) ' resize the array to hold 1 string
    ' Not a good idea because the array will have to be completely
    ' re-written each time you expand it: very slow!

    Set Ws = ThisWorkbook.Sheets("Sheet1")
    Rl = Ws.Cells(Ws.Rows.Count, "B").End(xlUp).Row     ' find the last used row in column B
    ReDim Fun(Rl)                           ' maximum to be possibly required

    For R = 2 To Rl
        If Ws.Cells(R, 3).Value = "Right" Then
            Fun(i) = Ws.Cells(R, 2).Value   'add the value in the array
            i = i + 1                       ' next empty array element
            ' ReDim Preserve DArrayRight(i) ' no need to re-write the array
        End If
    ' R = R + 1                             ' Next is doing the counting
    ' Loop                                  ' Next is doing the looping

    If i Then                               ' skip if no match was found
        ReDim Preserve Fun(i - 1)           ' delete the unused part of array
        ArrayRight = Fun
    End If
End Function

下面的子节显示了如何使用该功能。

Sub TryArrayRight()

    Dim Arr As Variant

    ' This is the function call.
    ' simply assign its return value to a variable
    Arr = ArrayRight

    ' now test the return
    If IsEmpty(Arr) Then
        MsgBox "The array is empty"
    Else
        MsgBox "The array has " & UBound(Arr) & " elements."

        ' pass the value to another procedure
        CellRightMarked Arr
    End If
End Sub

这里，从函数获得的变量作为参数传递给另一个例程。我注释掉了您的代码，因为我没有检查它。目的是显示变量的传递。

Sub CellRightMarked(DArrayRight As Variant)

'    Dim rcell As Range, rrow As Range
'    Dim R As Integer, i As Long
'
'    For Each sht In ActiveWorkbook.Worksheets
'       With sht
'         Set rrow = .UsedRange
'           For R = LBound(DArrayRight) To UBound(DArrayRight)
'            For Each rcell In rrow
'                If rcell.Value = DArrayRight(R) Then
'                    .Range(rcell.Offset(0, 1), rcell.Offset(0, 1)).Font.Color = 255
'                End If
'            Next rcell
'         Next R
'       End With
'    Next sht
 End Sub

当然，在这种特殊情况下，按照您自己的建议从CellRightMarked内调用该函数会更容易。

Answer 2

我已经按照您的建议解决了问题
非常感谢，这是我的解决方案

Sub DefineArrayRight()
...
Call CellRightMarked(darrayright) 
End Sub

和

Sub CellRightMarked(ByRef darrayright As Variant) 
...

在子例程之间传递动态数组

2 个答案: