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

时间:2015-08-30 12:07:17

标签: excel vba excel-vba

在我的宏中,我有一个子程序(使用for循环)遍历表的行,并根据列S中的内容在第V列中写入注释。在此循环期间,它还计算它的次数在第S列中说“新”。现在我想将此值传递到主宏并向下传递到另一个子例程。我该怎么做或者我的方法在这里错了?

如果我理解正确,它通常不可能从excel VBA中的subs返回值,但是你可以从一个函数中返回。但是我不认为函数在这里是合适的(我可能会误解函数在VBA中如何工作和/或没有充分发挥其潜力!)。

那么如何将变量/值从sub中移出到另一个变量/值?是GlobalPublic声明的唯一选项吗?

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

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表的格式,但这是另一个问题,你必须使用你给的东西,对吗?)

3 个答案:

答案 0 :(得分:2)

如果你真的坚持保持原样,只需将价值保存在其中一张纸上

Pseudocode:
Print: What scripture would you like to look up?
User: Romans 12:1
cur.execute("SELECT KJV FROM bible key")
cur.execute("SELECT 'Romans 12:1' FROM table")
print cur.execute

其中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 是您要保留的工作表,而wsi是单元格行和列值,然后就像这样,然后将其清除(或不)

j

但我觉得没有使用功能的真正原因

答案 1 :(得分: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

答案 2 :(得分:1)

如何在Subs(和Functions)之间传递和更新变量

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

.

我会使用自动过滤器替换CommentSub()Sub中的For循环:

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