-2

ЗАДАЧА РЕШЕНА
Это следующая часть моего вопроса, в последнем вопросе, который я задал «Как сделать, чтобы 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

И я получил «Ошибка компиляции, дублирующее объявление в текущей области». Не могли бы вы помочь мне, как объединить эти 2 отдельных кода в один модуль.

Вопрос Обновление 1

Большое спасибо @Bandersnatch, чтобы помочь мне прояснить этот вопрос
Сделка в
Январь на листе 2
Февраль на листе 3
Март на Листе4
так до
Декабрь на листе 13

Вопрос Обновление 2

Большое спасибо за то, что @KDavis предоставил мне базовый код и @Bandersnatch за то, что он побудил меня решить его самостоятельно с помощью Google. Я с гордостью представляю вам решенный код. (это мой первый проект Excel с VBS)

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 ответ1

0

Слияние модулей в ОДНОМ требует правильных координат, в противном случае это создает проблемы. Как вы тоже испытали.

Теперь вопрос в том, почему много модулей нужно поместить в один?

Позвольте мне объяснить сценарий. Предположим, у вас есть 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

Надеюсь, что это поможет вам понять, объединить много модулей в один полезно или нет.

|источник

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .