如何在Excel VBA中将值从一个子项传递给另一个

Question

在我的宏中，我有一个子程序（使用for循环）遍历表中的行，并在列V中写入注释，具体取决于列中的内容S.在此循环中，它还计算S列中“New”的次数。现在，我想将此值传递给主宏，然后传递给另一个子例程。我该怎么做，或者我的方法在这里错了？

如果我理解正确，通常不可能在excel VBA中从subs中返回值，但是可以从函数中返回。但是我不认为这里有一个函数是适合的（我可能会误解函数如何在VBA中工作和/或没有意识到它们的全部潜力！）。

那么我该如何走出变量/值从子和进入另一个？是唯一选项Global还是Public声明？

这里是我的代码一个非常粗略的例子：

Sub MainMacro() 
    Call CommentSub 
    Call NumberOfRowsToCopy 
End sub 

Sub CommentSub 
    Dim Counter As Integer 
    For Counter = 1 to 500 
    If Cells(Counter, "S") = "New" Then 
     NewOrderLineCounter = NewOrderLineCounter + 1 
     Cells(Counter, "V").Select 
     ActiveCell.FormulaR1C1 = "New Line" 
    End If 
    Next Counter 
End sub 

Sub NumberOfRowsToCopy 
    ActiveSheet.Range("$A$12:$T$1001").AutoFilter Field:=16, Criteria1:= _ 
    "New" 
    ActiveSheet.Range("B15:N" & NewOrderLineCounter).SpecialCells(xlCellTypeVisible).Select 
End sub 

（顺便说一句，我知道，有可能“更好”的方式来获得需要（从而消除了在这里复制的行数需要在subs之间传递值），但我想我已经尝试了所有这些方法，但都没有成功，我认为它是excel工作表的格式，但这是另一个问题，你得和你的工作一样，对吧？）

Answer 1

我不确定为什么你觉得这里的功能不适合。

它们与sub相同，它们只是具有返回值。

Private Sub MainMacro() 
    Dim lReturn As Long 

    'Get the return from the CommentSub 
    lReturn = CommentSub 

    'Pass that to the nextsub 
    NumberOfRowsToCopy (lReturn) 
End Sub 

Function CommentSub() As Long 'Declare the return type after the function 
    Dim NewOrderLineCounter As Long 
    Dim Counter As Integer 
    For Counter = 1 To 500 
    If Cells(Counter, "S") = "New" Then 
     NewOrderLineCounter = NewOrderLineCounter + 1 
     Cells(Counter, "V").Select 
     ActiveCell.FormulaR1C1 = "New Line" 
    End If 
    Next Counter 

    'Here you set the return value of the funtion 
    CommentSub = NewOrderLineCounter 
End Function 

Sub NumberOfRowsToCopy(lCount As Long) 'Declare the variable being passed to the sub. 
Dim NewOrderLineCounter As Long 
NewOrderLineCounter = lCount 
    ActiveSheet.Range("$A$12:$T$1001").AutoFilter Field:=16, Criteria1:= _ 
    "New" 
    ActiveSheet.Range("B15:N" & NewOrderLineCounter).SpecialCells(xlCellTypeVisible).Select 
End Sub 

或者如果您想要使用公共变量路由，请将它们声明在窗体或模块代码的顶部。高于所有功能和潜艇。

'Declared like this it can be accessed by any sub or function in this module or form. 
Private NewOrderLineCounter as Long 

'Declared like this it can be accessed by any sub or function in this module or form and from others. Although I think if it is in a form it will not be accessible from modules. For that you can create a module called globals and declare it there as public. 
Public NewOrderLineCounter as Long 

Sub MainMacro() 
    Call CommentSub 
    Call NumberOfRowsToCopy 
End sub 

Sub CommentSub 
    Dim Counter As Integer 
    For Counter = 1 to 500 
    If Cells(Counter, "S") = "New" Then 
     NewOrderLineCounter = NewOrderLineCounter + 1 
     Cells(Counter, "V").Select 
     ActiveCell.FormulaR1C1 = "New Line" 
    End If 
    Next Counter 
End sub 

Sub NumberOfRowsToCopy 
    ActiveSheet.Range("$A$12:$T$1001").AutoFilter Field:=16, Criteria1:= _ 
    "New" 
    ActiveSheet.Range("B15:N" & NewOrderLineCounter).SpecialCells(xlCellTypeVisible).Select 
End sub 

Answer 2

如果你真的坚持保留它，因为它是，刚刚保存该值在片中的一个这样的

Sub CommentSub 
    Dim Counter As Integer 
    For Counter = 1 to 500 
    If Cells(Counter, "S") = "New" Then 
     NewOrderLineCounter = NewOrderLineCounter + 1 
     Cells(Counter, "V").Select 
     ActiveCell.FormulaR1C1 = "New Line" 
    End If 
    Next Counter 
    ws.Cells(i,j).Value = Counter 
End sub 

其中ws是要保持它的工作表，并和i和j是细胞的行和列值，那么只是把它像这样的事后（或没有）清除

Sub NumberOfRowsToCopy 
    myCounter = ws.Cells(i,j).Value 
    ws.Cells(i,j).clear 
    ActiveSheet.Range("$A$12:$T$1001").AutoFilter Field:=16, Criteria1:= _ 
    "New" 
    ActiveSheet.Range("B15:N" & NewOrderLineCounter).SpecialCells(xlCellTypeVisible).Select 
End sub 

而我又觉得自己没有一个REA升理由不使用功能

Answer 3

如何通过和替补（和功能）之间更新变量

Option Explicit 

Public Sub MainSub() 

    Dim local_1 As Long 
    Dim local_2 As Long 

    local_1 = 0 
    local_2 = 0 

    setVal local_1    'Sub setVal() updates local_1 
    MsgBox local_1    'result: 1 

    putVal local_1    'Sub putVal() doesn't update local_1 
    MsgBox local_1    'result: 1 

    local_2 = getVal(local_1) 'Function getVal() updates local_1 and local_2 
    MsgBox local_1    'result: 2 
    MsgBox local_2    'result: 3 

End Sub 


Public Sub setVal(ByRef val As Long) 'pass ByRef (not a copy) 
    val = val + 1 
End Sub 

Public Sub putVal(ByVal val As Long) 'pass ByVal (a copy) 
    val = val + 1 
End Sub 

Public Function getVal(ByRef val As Long) As Long 
    val = val + 1    'updates val 
    getVal = val + 1   'doesn't update val (returns a new value) 
End Function 

. 

---

我会自动筛选代替For循环在你CommentSub（）子：

Public Sub MainMacro() 
    Dim newOrderRows As Long 

    Call CommentSub(newOrderRows) 
    Call NumberOfRowsToCopy(newOrderRows) 
End Sub 

Public Sub CommentSub(ByRef newOrderRows As Long) 
    Dim vRng As Range 

    With ActiveSheet.UsedRange 
     .AutoFilter Field:=19, Criteria1:="New" 
     Set vRng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Columns("V") 

     vRng.SpecialCells(xlCellTypeVisible) = "New Line" 
     newOrderRows = vRng.SpecialCells(xlCellTypeVisible).Count 
     .AutoFilter 
    End With 
End Sub 

Public Function NumberOfRowsToCopy(ByVal newOrderRows As Long) As Long 
    Dim x As Long 

    With ActiveSheet 
     .Range("A12:T" & .UsedRange.Rows.Count).AutoFilter Field:=16, Criteria1:="New" 
     x = .Range("N15:N" & 15 + newOrderRows).SpecialCells(xlCellTypeVisible).Count 
    End With 

    NumberOfRowsToCopy = x 
End Function