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