有没有办法将循环代码放入一个函数中，由VBA中的多个子集调用

我在excel中创build的表中有许多不同的类别。 每个子都有自己的数据，它从各种平面文件中提取，但是它们都有相同的结果，根据它在行和列中alignment的类别头将每个值放入特定的单元格。 所以，一开始就是if语句。 有没有办法把这个代码块放在一个单独的子函数或函数中，并且在每个子函数中只有一个调用，这样我就不必经常input/如果我想改变它，我会只需要在一个地方改变它？ 这是一个代码示例：

这部分是在每个子的开始，并根据行标题进行更改

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 

这部分将再次我是每个子的结束的一部分，而不是我想要的这个function的一部分

  End If Next k End Sub 

Answer 1

正如我在评论中发表的那样，你需要做的是将parameter passing给新的sub。 此外，你有很多反复的代码，所以我试图收紧。

 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 

Answer 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”不应该用这种方式来声明，你可以进一步改进它。 我没有看到你在哪里设置工作表，因此我想这只是代码的一小部分。 好好享受！

Answer 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语句嵌套在你的范围中。虽然看起来你并没有真正引用你的语句，所以你也许可以摆脱它。

我想知道你在哪里得到variables“ThisBook”“col1_n”/“col2_n”…因为你可能遇到一个“函数或variables未定义”的问题，除非你定义它们要么模块宽或作为parameter passing进入function。

你也没有定义CWS等于什么，所以你可能会得到一个对象所需的错误。 这是我认为在错误恢复下一个声明是关于。

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

 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 

祝你好运！

Answer 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)) ）。