如何在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