2

Это мой код:

'copy cells
Sub start()
'variable for all worksheets in the workbook
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim sh4 As Worksheet
Dim sh5 As Worksheet
Dim sh6 As Worksheet
Dim sh7 As Worksheet
Dim sh8 As Worksheet
Dim sh9 As Worksheet
Dim sh10 As Worksheet
Dim sh11 As Worksheet
Dim sh12 As Worksheet
Dim sh13 As Worksheet
Dim sh14 As Worksheet
Dim sh15 As Worksheet
Dim sh16 As Worksheet
Dim sh17 As Worksheet
Dim sh18 As Worksheet
Dim sh19 As Worksheet
Dim sh20 As Worksheet
Dim sh21 As Worksheet
Dim sh22 As Worksheet
Dim sh23 As Worksheet
Dim sh24 As Worksheet
Dim sh25 As Worksheet
Dim sh26 As Worksheet
Dim sh27 As Worksheet
Dim sh28 As Worksheet
Dim sh29 As Worksheet
Dim sh30 As Worksheet
Dim sh31 As Worksheet
Dim sh32 As Worksheet
Dim sh33 As Worksheet
Dim sh34 As Worksheet
Dim sh35 As Worksheet
Dim sh36 As Worksheet
Dim sh37 As Worksheet
Dim sh38 As Worksheet
Dim sh39 As Worksheet
Dim sh40 As Worksheet
'variable for the workbook itself
Dim wkb As Workbook
'set workbook
Set wkb = Workbooks("macro2.xlsm")
With wkb 'create with statement to call on worksheets

Set sh1 = .Sheets("1")
Set sh2 = .Sheets("2")
Set sh3 = .Sheets("3")
Set sh4 = .Sheets("4")
Set sh5 = .Sheets("5")
Set sh6 = .Sheets("6")
Set sh7 = .Sheets("7")
Set sh8 = .Sheets("8")
Set sh9 = .Sheets("9")
Set sh10 = .Sheets("10")
Set sh11 = .Sheets("11")
Set sh12 = .Sheets("12")
Set sh13 = .Sheets("13")
Set sh14 = .Sheets("14")
Set sh15 = .Sheets("15")
Set sh16 = .Sheets("16")
Set sh17 = .Sheets("17")
Set sh18 = .Sheets("18")
Set sh19 = .Sheets("19")
Set sh20 = .Sheets("20")
Set sh21 = .Sheets("21")
Set sh22 = .Sheets("22")
Set sh23 = .Sheets("23")
Set sh24 = .Sheets("24")
Set sh25 = .Sheets("25")
Set sh26 = .Sheets("26")
Set sh27 = .Sheets("27")
Set sh28 = .Sheets("28")
Set sh29 = .Sheets("29")
Set sh30 = .Sheets("30")
Set sh31 = .Sheets("31")
Set sh32 = .Sheets("32")
Set sh33 = .Sheets("33")
Set sh34 = .Sheets("34")
Set sh35 = .Sheets("35")
Set sh36 = .Sheets("36")
Set sh37 = .Sheets("37")
Set sh38 = .Sheets("38")
Set sh39 = .Sheets("39")
Set sh40 = .Sheets("40")
Set shsum = .Sheets("sum") 'name sheet to copy to
'add more if there are more sheets example
'set sh41 = .sheets("41")

'name first range to copy
sh1.Range("b8").copy shsum.Range("a2")
sh1.Range("b5").copy shsum.Range("b2")
sh1.Range("b4").copy shsum.Range("c2")
sh1.Range("G13:G30").copy shsum.Range("d2:d18")
sh1.Range("h13:h30").copy shsum.Range("e2:e18")
sh1.Range("i13:i30").copy shsum.Range("f2:f18")
sh1.Range("j13:j30").copy shsum.Range("g2:g18")
sh1.Range("k13:k30").copy shsum.Range("h2:h18")

End With
End Sub

Чтобы получить данные на 40 листах, мне нужно было бы вводить каждый лист с той же информацией, которую вы видите, и это тонна набора текста.

  • Есть ли способ, которым я могу сделать какой-то массив для листов?
  • Затем мне нужно пропустить 18 строк вниз для каждого дополнительного листа, чтобы не перекрывать данные в sum листе. Это связано с тем, что с g13 по k30 имеется 18 строк данных, которые необходимо заполнить. B8, b5 и b4 - это имя элемента (X), номер (Y) и номер (Z), связанные с элементами, которые занимают g13 через K30 в каждой таблице. Мне нужно убедиться, что данные каждой электронной таблицы, скопированные в sum таблицу суммы, содержат элементы X , Y и Z в первой строке, за которыми следуют связанные элементы длиной 18 строк.

1 ответ1

4
Option Explicit

'copy cells
Sub start()
Dim ws As Worksheet, wsum As Worksheet
Dim wb As Workbook
Dim vws As Variant 'Need to use a Variant for iterator
Dim i As Integer, j As String, k As String

i = 0
Set wb = Workbooks("macro2.xlsm")
Set wsum = wb.Sheets("sum")

'Iterate through the sheets
For Each vws In wb.Sheets
If vws.Name <> "sum" Then 
j = CStr(i + 2)
k = CStr(i + 18)
vws.Range("b8").Copy wsum.Range("a" & j)
vws.Range("b5").Copy wsum.Range("b" & j)
vws.Range("b4").Copy wsum.Range("c" & j)
vws.Range("G13:G30").Copy wsum.Range("d" & j & ":d" & k)
vws.Range("h13:h30").Copy wsum.Range("e" & j & ":e" & k)
vws.Range("i13:i30").Copy wsum.Range("f" & j & ":f" & k)
vws.Range("j13:j30").Copy wsum.Range("g" & j & ":g" & k)
vws.Range("k13:k30").Copy wsum.Range("h" & j & ":h" & k)
i = i + 18
End If
Next
End Sub

Сильно переработан для использования циклов и конкатенации строк. Только тестирование компилируется, поэтому может не сработать; любые дефекты - ваши, и если вы не удовлетворены, я верну полную стоимость покупки. Спасибо за покупки в McSoftware.

Это очень простой (не каламбур), и вы должны научиться этому. Несколько пояснений, объясняющих, как я это придумал:

  • For Each vws In wb.Sheets перебирают каждый лист в книге. "Итерация" означает "шаг за шагом и обрабатывать каждый элемент отдельно в цикле".
  • Если вам требуется более дюжины переменных в функции, вы делаете это неправильно и должны немедленно остановиться и попробовать что-то еще. Задать вопрос о SuperUser - не лучшее, что вы могли бы сделать, но это лучше, чем копировать и вставлять ваш код еще 48 раз, поэтому я приветствую вас, по крайней мере, осознавая, что возникла проблема.
  • Конкатенация строк означает, что нужно взять две меньшие строки и соединить их вместе. Например, "he" и "llo" приведут к объединенной строке "hello". Оператор & используется для объединения строк в Visual Basic.
  • Вероятно, вы можете еще больше уменьшить повторяемость этого кода, добавив цикл и создав постоянный массив букв для "d", "e", "f", "g", "h" - но так как их было всего пять их, усилия по написанию цикла почти такие же, как и по одному. Если у вас получится намного больше столбцов, обязательно напишите цикл с массивом или словарем букв.
  • Я использовал преобразование чисел в строки с помощью функции CStr() чтобы преобразовать целое число i плюс константу, полученную из вашего исходного кода. Таким образом, на первой итерации цикла будет помещен vws.Range("b8") в диапазоне A2 таблицы сумм, потому что 0 + 2 = 2 . В конце цикла обратите внимание на i = i + 18 чтобы увеличить счетчик, чтобы на второй итерации эта же ячейка на втором листе вместо этого копировалась в диапазон A20 листа. Возможно, вам придется скорректировать числа, потому что я не могу сказать из ваших исходных данных, будет ли это случайно перезаписывать / растоптать строки или нет.

Рекомендации

Прежде чем пытаться что-нибудь более экзотическое в Visual Basic (для приложений), прочитайте книгу по программированию.

  • Очень простая книга, которая проведет вас шаг за шагом (вероятно, то, что вам нужно) здесь - Excel VBA in Easy Steps от Ed Robinson.
  • Старый, но хороший, VBA Developer's Handbook 2nd Edition Кена Гетца.

Вы также можете получить дополнительную перспективу и понимание того, как стать опытным программистом, если вы попробуете более современный и универсальный язык программирования, такой как Python или Java или C++, просто чтобы изучить концепции, которые помогут вам написать хороший код на любом языке.

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