☰

如何在 Excel VBA 中将多个模块合并为单个模块

tag-icon • tag-icon microsoft-excel microsoft-excel-2010 vba microsoft-excel-2007
如何在 Excel VBA 中将多个模块合并为单个模块

问题解决了
这是我的问题的下一部分，在上一个问题中我问过“如何让 excel 自动复制带有日期的特定单元格”

链接在这里， 如何让 Excel 自动复制带有日期的特定单元格

我发现此代码最适合我的项目

Sub Transaction_February()

    ' ws = the worksheet that contains the code to copy
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)

    'Create a multi-dimensional array that contains your two columns of data
    Dim myArr() As Variant
    myArr = ws.UsedRange.Columns("A:H").Value

    'ws2 = the worksheet you are copying TO
    Dim i As Long, ws2 As Worksheet, x As Long
    Set ws2 = ThisWorkbook.Worksheets(3)

    'Loop the array, and if it matches your month of 2 (Feb) then copy
    'the data from ws to ws2
    With ws2
        For i = 1 To UBound(myArr)
            If Month(myArr(i, 1)) = 2 Then  ' 2 = February
                x = x + 1
                .Cells(x, 1) = myArr(i, 1)  ' the ,1 is column A
                .Cells(x, 2) = myArr(i, 2)  ' the ,2 is column B
                .Cells(x, 3) = myArr(i, 3)
                .Cells(x, 4) = myArr(i, 4)
                .Cells(x, 5) = myArr(i, 5)
                .Cells(x, 6) = myArr(i, 6)
                .Cells(x, 7) = myArr(i, 7)
                .Cells(x, 8) = myArr(i, 8)
            End If
        Next
    End With

End Sub

我想将其中 12 个代码合并到一个模块中，这样当我在日志中完成重大数据更改时只需要刷新一个模块。

问题是当我将该代码合并为单个代码时，我总是得到错误代码。下面是我如何合并它

Option Explicit

Sub Transaction_February_March()

    ' ws = the worksheet that contains the code to copy
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)

    'Create a multi-dimensional array that contains your two columns of data
    Dim myArr() As Variant
    myArr = ws.UsedRange.Columns("A:H").Value

    'ws2 = the worksheet you are copying TO
    Dim i As Long, ws2 As Worksheet, x As Long
    Set ws2 = ThisWorkbook.Worksheets(3)

    'Loop the array, and if it matches your month of 2 (Feb) then copy
    'the data from ws to ws2
    With ws2
        For i = 1 To UBound(myArr)
            If Month(myArr(i, 1)) = 2 Then  ' 2 = February
                x = x + 1
                .Cells(x, 1) = myArr(i, 1)  ' the ,1 is column A
                .Cells(x, 2) = myArr(i, 2)  ' the ,2 is column B
                .Cells(x, 3) = myArr(i, 3)
                .Cells(x, 4) = myArr(i, 4)
                .Cells(x, 5) = myArr(i, 5)
                .Cells(x, 6) = myArr(i, 6)
                .Cells(x, 7) = myArr(i, 7)
                .Cells(x, 8) = myArr(i, 8)
            End If
        Next
    End With

    ' ws = the worksheet that contains the code to copy
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)

    'Create a multi-dimensional array that contains your two columns of data
    Dim myArr() As Variant
    myArr = ws.UsedRange.Columns("A:H").Value

    'ws2 = the worksheet you are copying TO
    Dim i As Long, ws2 As Worksheet, x As Long
    Set ws2 = ThisWorkbook.Worksheets(4)

    'Loop the array, and if it matches your month of 2 (Feb) then copy
    'the data from ws to ws2
    With ws2
        For i = 1 To UBound(myArr)
            If Month(myArr(i, 1)) = 3 Then  ' 2 = February
                x = x + 1
                .Cells(x, 1) = myArr(i, 1)  ' the ,1 is column A
                .Cells(x, 2) = myArr(i, 2)  ' the ,2 is column B
                .Cells(x, 3) = myArr(i, 3)
                .Cells(x, 4) = myArr(i, 4)
                .Cells(x, 5) = myArr(i, 5)
                .Cells(x, 6) = myArr(i, 6)
                .Cells(x, 7) = myArr(i, 7)
                .Cells(x, 8) = myArr(i, 8)
            End If
        Next
    End With
End Sub

我得到了“编译错误，当前范围内的重复声明”。你能帮我把这两个独立的代码合并成一个模块吗？

问题更新 1

非常感谢@Bandersnatch 帮我澄清这个问题

一月份的交易记录在工作表 2 上，
二月份的交易记录在工作表 3 上，三月份的交易
记录在工作表 4 上，
依此类推，直到
十二月的交易记录在工作表 13 上。

问题更新 2

非常感谢@KDavis 为我提供基础代码，以及@Bandersnatch 鼓励我自己在谷歌的帮助下解决问题。我很自豪地向你们展示解决的代码。（这是我的第一个带有 VBS 的 Excel 项目）

Sub Transaction_January_to_March()

    ' ws = the worksheet that contains the code to copy
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)

    'Create a multi-dimensional array that contains your two columns of data
    Dim myArr() As Variant
    myArr = ws.UsedRange.Columns("A:H").Value

    'ws2 = the worksheet you are copying to Transaction January
    Dim a As Long, ws2 As Worksheet, b As Long
    Set ws2 = ThisWorkbook.Worksheets(2)

    'ws3 = the worksheet you are copying to Transaction February
    Dim c As Long, ws3 As Worksheet, d As Long
    Set ws3 = ThisWorkbook.Worksheets(3)

    'ws4 = the worksheet you are copying to Transaction March
    Dim e As Long, ws4 As Worksheet, f As Long
    Set ws4 = ThisWorkbook.Worksheets(4)

    'Loop the array, and if it matches your month of 2 (Feb) then copy
    'the data from ws to ws2
    With ws2
        For a = 1 To UBound(myArr)
            If Month(myArr(a, 1)) = 1 Then  ' 1 = January
                b = b + 1
                .Cells(b, 1) = myArr(a, 1)  ' the ,1 is column A
                .Cells(b, 2) = myArr(a, 2)  ' the ,2 is column B
                .Cells(b, 3) = myArr(a, 3)  ' the ,3 is column C
                .Cells(b, 4) = myArr(a, 4)  ' the ,4 is column D
                .Cells(b, 5) = myArr(a, 5)  ' the ,5 is column E
                .Cells(b, 6) = myArr(a, 6)  ' the ,6 is column F
                .Cells(b, 7) = myArr(a, 7)  ' the ,7 is column G
                .Cells(b, 8) = myArr(a, 8)  ' the ,8 is column H
            End If
        Next
    End With
    With ws3
        For c = 1 To UBound(myArr)
            If Month(myArr(c, 1)) = 2 Then  ' 2 = February
                d = d + 1
                .Cells(d, 1) = myArr(c, 1)  ' the ,1 is column A
                .Cells(d, 2) = myArr(c, 2)  ' the ,2 is column B
                .Cells(d, 3) = myArr(c, 3)  ' the ,3 is column C
                .Cells(d, 4) = myArr(c, 4)  ' the ,4 is column D
                .Cells(d, 5) = myArr(c, 5)  ' the ,5 is column E
                .Cells(d, 6) = myArr(c, 6)  ' the ,6 is column F
                .Cells(d, 7) = myArr(c, 7)  ' the ,7 is column G
                .Cells(d, 8) = myArr(c, 8)  ' the ,8 is column H
            End If
        Next
    End With
    With ws4
        For e = 1 To UBound(myArr)
            If Month(myArr(e, 1)) = 3 Then  ' 3 = March
                f = f + 1
                .Cells(f, 1) = myArr(e, 1)  ' the ,1 is column A
                .Cells(f, 2) = myArr(e, 2)  ' the ,2 is column B
                .Cells(f, 3) = myArr(e, 3)  ' the ,3 is column C
                .Cells(f, 4) = myArr(e, 4)  ' the ,4 is column D
                .Cells(f, 5) = myArr(e, 5)  ' the ,5 is column E
                .Cells(f, 6) = myArr(e, 6)  ' the ,6 is column F
                .Cells(f, 7) = myArr(e, 7)  ' the ,7 is column G
                .Cells(f, 8) = myArr(e, 8)  ' the ,8 is column H
            End If
        Next
    End With
End Sub

答案1

将模块合并为一个需要适当的坐标，否则会产生问题。正如您所经历的那样。

现在的问题是为什么需要将许多模块放入一个模块中？

让我解释一下这个场景。假设你有 4 个模块，你需要一个接一个地执行它们，但什么都没有。在这种情况下，你可以按所需的顺序调用它们，就像这样，

Sub MasterMacro()
    Call Macro1
    Call Macro2
    Call Macro3
    Call Macro4
End Sub

其他情况下，如果你需要像这样根据情况或条件调用模块，

Sub MasterMacro()

If Range("A2").Value = 1 Then Exit Sub

If Range("A2").Value = 2 Then
 Call Macro1
  Elseif Range("A2").Value = 3 Then
   Call Macro2
  End If
Endif

End Sub

希望这能帮助您了解将多个模块合并为一个是否有用。

相关内容