有没有办法将重复代码放入一个函数中，由 VBA 中的多个子调用答案

【问题标题】：Is there a way to place recurring code into a function to be called by multiple subs in VBA有没有办法将重复代码放入一个函数中，由 VBA 中的多个子调用
【发布时间】：2016-07-20 14:45:38
【问题描述】：

我在 Excel 中构建的表中有一堆不同类别的子项。每个 sub 都有自己的数据，它从各种平面文件中提取，但它们都有相同的结尾，即根据它在行和列中对齐的类别标题将每个值放入特定的单元格中。因此，所有不同的是开头的 if 语句。有没有办法把这段代码放在一个单独的子或函数或其他东西中，并且在每个其他子中只调用一次，这样我就不必经常输入它/如果我想改变它，我会只需要在一个地方更改吗？下面是代码示例：

这部分在每个sub的开头，根据行头变化

Sub calccategory()

    For k = 1 To ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
        If Cells(k, 4) = "row 1" Then

这部分是我想放在函数或子中的部分，因为它每次都是一样的

            Dim CWS As Worksheet
            Workbooks(ThisBook).Activate

            For j = 5 To 15

                For g = 1 To ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column

                    If Cells(3, g) = "col1" Then

                        With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
                            On Error Resume Next
                            CWS.Cells(k, g).Value = col1_n
                        End With

                    ElseIf Cells(3, g) = "col2" Then

                        With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
                            On Error Resume Next
                            CWS.Cells(k, g).Value = col2_n
                        End With

                    ElseIf Cells(3, g) = "col3" Then

                        With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
                            On Error Resume Next
                            CWS.Cells(k, g).Value = col3_n
                        End With

                    ElseIf Cells(3, g) = "col 4" Then

                        With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
                            On Error Resume Next
                            CWS.Cells(k, g).Value = col4_n
                        End With

                    ElseIf Cells(3, g) = "col5" Then

                        With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
                            On Error Resume Next
                            CWS.Cells(k, g).Value = col5_n
                        End With

                    End If

                Next g

                On Error GoTo 0

            Next j

这部分将再次成为每个 sub 末尾的一部分，而不是我想要的此功能的一部分

        End If

    Next k

End Sub

【问题讨论】：

您希望在单独的函数中使用的代码块是否需要任何输入？为什么你不能把它放在它自己的 sub 中，然后从你的 main 函数中调用那个 sub？
我试过了——如果我这样做，我必须将其他字母变量（如 k 和 j）放入循环中，这会破坏目的，而且它也不会映射到正确的行
If Cells(k,4) = row 1" 是什么？你的意思是Cells(k,4)所在的行是第1行吗？
查看passing arguments to Functions
你真的会添加更多关于你的代码应该做什么的信息。有很多奇怪的东西，最奇怪的是With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))引用根本没有被利用，因为下一个End With中的任何语句都没有任何点（。）......无论如何我会添加一个我能理解的答案

标签： vba function excel subroutine

【解决方案1】：

正如我在评论中发布的那样，您需要做的是将参数传递给新子。另外，你有很多重复的代码，所以我试着把它收紧。

Sub calccategory()
For k = 1 To ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
    If Cells(k, 4) = "row 1" Then
        theLoop k
    End If
Next k
End Sub

Sub theLoop(ByVal k As Integer)
Dim CWS     As Worksheet

Set CWS = Workbooks(ThisBook)

For j = 5 To 15
    With CWS
        For g = 1 To .Cells(3, .Columns.Count).End(xlToLeft).Column
            With .Range(.Cells(k, j * 4 + 2), .Cells(k + 1, j * 4 + 4))
                On Error Resume Next
                If .Cells(3, g) = "col1" Then .Cells(k, g).Value = col1_n
                    ElseIf .Cells(3, g) = "col2" Then .Cells(k, g).Value = col2_n
                    ElseIf .Cells(3, g) = "col3" Then .Cells(k, g).Value = col3_n
                    ElseIf .Cells(3, g) = "col 4" Then .Cells(k, g).Value = col4_n
                    ElseIf .Cells(3, g) = "col5" Then .Cells(k, g).Value = col5_n
            End If
        End With
    Next g
End With                     'CWS
On Error GoTo 0
Next j
End Sub

【讨论】：

【解决方案2】：

好吧，你应该做这样的事情......

Option Explicit


Public Sub CalCategoryInternal(ByVal str_col2 As String, _
                             ByVal g As Long, _
                             ByVal k As Long, _
                             ByVal j As Long, _
                             ByRef CWS As Worksheet)


        With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
            On Error Resume Next

            CWS.Cells(k, g).Value = str_col2

            On Error GoTo 0

        End With

    End Sub

Sub calccategory()

    Dim k, ThisBook, j, g, col1_n, col2_n, col3_n, col4_n, col5_n


    For k = 1 To ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
        If Cells(k, 4) = "row 1" Then

            Dim CWS As Worksheet

            Workbooks(ThisBook).Activate

            For j = 5 To 15

                For g = 1 To ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column
                    If Cells(3, g) = "col1" Then

                        Call CalCategoryInternal("col1", g, k, j, CWS)
'                        With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
'                            On Error Resume Next
'                            CWS.Cells(k, g).Value = col1_n
'                        End With

                    ElseIf Cells(3, g) = "col2" Then
                        Call CalCategoryInternal("col1", g, k, j, CWS)
                        With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
                            On Error Resume Next
                            CWS.Cells(k, g).Value = col2_n
                        End With

                    ElseIf Cells(3, g) = "col3" Then
                        With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
                            On Error Resume Next
                            CWS.Cells(k, g).Value = col3_n
                        End With

                    ElseIf Cells(3, g) = "col 4" Then
                        With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
                            On Error Resume Next
                            CWS.Cells(k, g).Value = col4_n
                        End With

                    ElseIf Cells(3, g) = "col5" Then
                        With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
                            On Error Resume Next
                            CWS.Cells(k, g).Value = col5_n
                        End With

                    End If

                Next g

                On Error GoTo 0
            Next j
        End If
    Next k


End Sub

当心 - 这确实是一个低质量的代码。例如。顶部的“Dim”不应该这样声明，你可以进一步改进它。我看不到您在哪里设置工作表，因此我想这只是代码的一小部分。尽情享受吧！

【讨论】：

【解决方案3】：

是的，您可以轻松地将其粘贴到它自己的子中，并且您可以将 K 作为值的参数传递给它，看起来就像这样：

Sub calccategory()

For k = 1 To ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
  If Cells(k, 4) = row 1" Then
    Call newSub(k)
  End If
 Next k
 End Sub

Sub newSub(byval k as long)
Dim CWS As Worksheet

Workbooks(ThisBook).Activate  

For j = 5 To 15

For g = 1 To ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column
  If Cells(3, g) = "col1" Then

With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
 On Error Resume Next    
CWS.Cells(k, g).Value = col1_n    
End With

 ElseIf Cells(3, g) = "col2" Then    
    With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
     On Error Resume Next  
   CWS.Cells(k, g).Value = col2_n
 End With

ElseIf Cells(3, g) = "col3" Then    
    With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
     On Error Resume Next    
   CWS.Cells(k, g).Value = col3_n    
End With

ElseIf Cells(3, g) = "col 4" Then
With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
     On Error Resume Next      
   CWS.Cells(k, g).Value = col4_n    
End With

ElseIf Cells(3, g) = "col5" Then
With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
     On Error Resume Next     
CWS.Cells(k, g).Value = col5_n
End With    

End If

Next g


  On Error GoTo 0
  Next j

end sub

您也可以考虑使用 select 语句并将您的 select 语句嵌套在您的 with 范围内。虽然看起来您实际上并没有引用您的 with 语句，因此您可能可以摆脱它。

我想知道您从哪里获得变量“ThisBook”“col1_n”/“col2_n”......因为除非您在模块范围内定义它们或传递它们，否则您可能会遇到“未定义函数或变量”问题in 作为函数的参数。

您也没有定义 CWS 等于任何东西，因此您可能会收到 object required 错误。这就是我假设 on error resume next 语句的内容。

所以一些改进可能看起来类似于：

Sub calccategory()

    For k = 1 To ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
        If Cells(k, 4) = "row 1" Then
            Call newSub(k)
        End If
    Next k

End Sub
Sub newSub(ByVal k As Long)
Dim CWS As Worksheet
Set CWS = Workbooks(ThisBook).Sheets("mySheetName")

For j = 5 To 15
    On Error Resume Next
    For g = 1 To ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column
        If Cells(3, g) = "col1" Then
            With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))        'still unused
                CWS.Cells(k, g).Value = col1_n
                Select Case Cells(3, g)
                    Case "col2"
                        CWS.Cells(k, g).Value = col2_n
                    Case "col3"
                        CWS.Cells(k, g).Value = col3_n
                    Case "col 4"
                        CWS.Cells(k, g).Value = col4_n
                    Case "col5"
                        CWS.Cells(k, g).Value = col5_n
                End Select
            End With
        End If
    Next g
    On Error GoTo 0
Next j
End Sub

祝你好运！

【讨论】：

【解决方案4】：

在您添加更多信息的同时，我可以输入以下内容：

Option Explicit

Sub calccategory()
    Dim k As Long
    Dim CWS As Worksheet
    Dim col1_n As Variant, col2_n As Variant, col3_n As Variant, col4_n As Variant, col5_n As Variant

    With ActiveSheet
        For k = 1 To .Cells(Rows.Count, 4).End(xlUp).Row
            If .Cells(k, 4) = "row 1" Then FillValues k, Workbooks("ThisBook").ActiveSheet, CWS, Array(col1_n, col2_n, col3_n, col4_n, col5_n)
        Next k
    End With

End Sub

Sub FillValues(k As Long, ws As Worksheet, CWS As Worksheet, colArray As Variant)
    Dim j As Long, G As Long, col As Long
    Dim strng As String

    With ws
'        For j = 5 To 15 '<--| I commented it since it seems not to be used anywhere, once removing that 'With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))'
            For G = 1 To .Cells(3, .Columns.Count).End(xlToLeft).Column
                strng = .Cells(3, G).Value2
                If Left(strng, 3) = "col" Then
                    If IsNumeric(Mid(strng, 4, 1)) Then
                        col = CLng(Mid(strng, 4, 1))
                        If col <= 5 Then CWS.Cells(k, G).Value = colArray(col - 1)
                    End If
                End If
            Next G
'        Next j
    End With
End Sub

但是你应该解释很多事情（ThisBook、CWS、With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))）来理解它！

【讨论】：

@durba138：你熬过去了吗？