在主子例程中调用VBA自定义函数

时间:2015-12-10 14:40:36

标签: excel vba

我有两个函数,它们都根据单元格中的值确定输出。结果是N列应该具有函数mBlineCTG + findShpc的组合输出。它们分开工作,我想在主函数上调用它们,这样我就不必单独运行这两个例程。我愿意接受包括

背后的逻辑在内的帮助
Option Compare Text
Sub Main()
 M_xx
 f_xxx
 Cells(i, 14).Value = M_xx + f_xxx
 Range("Q1").Value = "xxx_xxxx"
End Sub

Public Function M_xxx()
 Dim LastRow As Long
 LastRow = Cells(Rows.Count, 1).End(xlUp).Row

 Dim  s_Cxx
 Dim i As Integer

For i = 2 To LastRow
Select Case UCase(Left(Cells(i, 10).Value, 1))
    Case "s"
        s_Cxx = "D"
    Case "0"
         s_Cxx= "SD"
    Case "1", "R", "E", "F"
        Select Case UCase(Left(Cells(i, 13).Value, 2))
          Case "13"
             s_Cxx = "SB"
            Case Else
             s_Cxx = "SS"
        End Select
    Case "I"
      s_Cxx = "IS"
    Case "2", "15"
         s_Cxx = "BB"
    Case "3"
         s_Cxx = "SF"
    Case Else
         s_Cxx = ""
 End Select

    Next i
End Function

Public Function f_xxxx()
 'declare variables
 Dim LastRow As Long

 LastRow = Cells(Rows.Count, 1).End(xlUp).Row
 'Dim ThisCont
 'ThisCont = Range("E2").Value
  Dim S_xxx2
  'loop thru' rows 
  Dim i As Integer

  For i = 2 To LastRow
  Select Case UCase(Left(Cells(i, 5).Value, 1))
   'Select Case ThisCont
        Case "A"
           S_xxx2 = "big-base-Post-01 0 01 Cee-xx-04"
        Case "X"
           S_xxx2 = "small-shelf-Post-01 0 01 Cee-xx-01"
        Case Else
           S_xxx2= "big-drawer-Post-01 0 01 Cee-xx-06"
  End Select
   'Cells(i, 14).Value = S_xxx2
 Next i
End Function

1 个答案:

答案 0 :(得分:1)

我认为你有一些困惑,因为你要两次调用这两个函数。

对每个调用的第一次调用是多余的,因为它不会任何值返回到主过程。第二个调用是错误,因为在i过程的范围内未定义Main

Option Compare Text
Sub Main()
 mBlineCTG   '<-- calls the mBlineCTG function but does not return any value
 findShpc    '<-- calls the findShpc function but does not return any value
 Cells(i, 14).Value = mBlineCTG + findShpc  'This line is an error because "i" _
                                             is undefined, but this would writes the _
                                             sum of two functions to Column N/Row i, _
                                             if "i" is an integer >= 1
 Range("N1").Value = "SHP_SRC"  '<-- overwrites the value in Range("N1")
End Sub

我认为这就是你所需要的:

Option Compare Text
Sub Main()
 Range("N1").Value = mBlineCTG & findShpc  '<-- concatenates mBlineCTG and findShpc in to range("N1")
End Sub

另外,我注意到你的两个函数都没有任何类型的返回值,所以这实际上不会写任何东西到N1单元格...你需要详细说明什么是预期的产出。

我认为这可能会照顾它,在main函数中执行循环(而不是在被调用函数中执行冗余循环):

Option Compare Text
Option Explicit
Sub Main()
Dim FinalRow As Long
Dim i As Long

FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To FinalRow
    Range("N2").Cells(i).Value = mBlineCTG(i) & findShpc(i) '<-- concatenates mBlineCTG and findShpc in to range("N1")
Next
End Sub


Public Function mBlineCTG(i As Long)
    Dim ThisCont
    Dim shpCt As String

    Select Case UCase(Left(Cells(i, 13).Value, 1))
        Case "D"
            shpCt = "D"
        Case "0"
            shpCt = "V"
        Case "1", "R", "E", "F"
            Select Case UCase(Left(Cells(i, 13).Value, 2))
              Case "13"
                shpCt = "B"
                Case Else
                shpCt = "S"
            End Select
        Case "I"
            shpCt = "I"
        Case "2", "15"
            shpCt = "B"
        Case "3"
            shpCt = "F"
        Case Else
            shpCt = ""
     End Select

     '#### RETURN THE VALUE TO CALLING PROCEDURE:
     mBlineCTG = shpCt

End Function

Public Function findShpc(i As Long)
  Dim SHPcT2 As String
  Select Case UCase(Left(Cells(i, 5).Value, 1))
   'Select Case ThisCont
        Case "A"
           SHPcT2 = "L-BM-PS-01 0 01 CC-LG-01"
        Case "X"
           SHPcT2 = "X-BM-PS-01 0 01 CC-XX-01"
        Case Else
           SHPcT2 = "S-SH-PS-01 0 01 CC-SM-01"
  End Select
  '#### RETURN THE VALUE TO CALLING PROCEDURE:
  findShpc = SHPcT2
End Function