Как упростить код с помощью LOOPS в VBA?

Как упростить код с помощью LOOPS в VBA?

Мне нужно скопировать содержимое столбца на одном листе и вставить его на другой (одновременно сделав в общей сложности 7 копий каждой переменной). Есть несколько столбцов, и каждый столбец имеет разное количество переменных. К сожалению, из-за размера данных мой текущий код невыполним. У меня есть чувство, что его можно написать через цикл.

Моя логика была такова: если Excel может обнаружить текст в столбце, то он должен скопировать ячейку под ним и вставить ее в диапазон (таким образом создавая 7 копий). Надеюсь, это имеет смысл. Любая помощь будет высоко оценена!

Вот мой код:

Sub SimpleCopy()

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("E2")) = True Then
Worksheets("Investor Data").range("E3").copy Worksheets("Data Base").range("C114:C120")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("E2")) = True Then
Worksheets("Investor Data").range("E4").copy Worksheets("Data Base").range("C121:C127")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("E2")) = True Then
Worksheets("Investor Data").range("E5").copy Worksheets("Data Base").range("C128:C134")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("E2")) = True Then
Worksheets("Investor Data").range("E6").copy Worksheets("Data Base").range("C135:C141")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("E2")) = True Then
Worksheets("Investor Data").range("E7").copy Worksheets("Data Base").range("C142:C148")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("E2")) = True Then
Worksheets("Investor Data").range("E8").copy Worksheets("Data Base").range("C149:C155")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("E2")) = True Then
Worksheets("Investor Data").range("E9").copy Worksheets("Data Base").range("C156:C162")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("E2")) = True Then
Worksheets("Investor Data").range("E10").copy Worksheets("Data Base").range("C163:C169")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("E2")) = True Then
Worksheets("Investor Data").range("E11").copy Worksheets("Data Base").range("C170:C176")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("E2")) = True Then
Worksheets("Investor Data").range("E12").copy Worksheets("Data Base").range("C177:C183")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("E2")) = True Then
Worksheets("Investor Data").range("E13").copy Worksheets("Data Base").range("C184:C190")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("E2")) = True Then
Worksheets("Investor Data").range("E14").copy Worksheets("Data Base").range("C191:C197")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("E2")) = True Then
Worksheets("Investor Data").range("E15").copy Worksheets("Data Base").range("C198:C204")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("F2")) = True Then
Worksheets("Investor Data").range("F2").copy Worksheets("Data Base").range("B205")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("F2")) = True Then
Worksheets("Investor Data").range("F3").copy Worksheets("Data Base").range("C205:C211")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("F2")) = True Then
Worksheets("Investor Data").range("F4").copy Worksheets("Data Base").range("C212:C218")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("F2")) = True Then
Worksheets("Investor Data").range("F5").copy Worksheets("Data Base").range("C219:C225")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("G2")) = True Then
Worksheets("Investor Data").range("G2").copy Worksheets("Data Base").range("B226")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("G2")) = True Then
Worksheets("Investor Data").range("G3").copy Worksheets("Data Base").range("C226:C232")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("G2")) = True Then
Worksheets("Investor Data").range("G4").copy Worksheets("Data Base").range("C233:C239")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("G2")) = True Then
Worksheets("Investor Data").range("G5").copy Worksheets("Data Base").range("C240:C246")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("G2")) = True Then
Worksheets("Investor Data").range("G6").copy Worksheets("Data Base").range("C247:C253")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("H2")) = True Then
Worksheets("Investor Data").range("H2").copy Worksheets("Data Base").range("B254")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("H2")) = True Then
Worksheets("Investor Data").range("H3").copy Worksheets("Data Base").range("C254:C260")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("H2")) = True Then
Worksheets("Investor Data").range("H4").copy Worksheets("Data Base").range("C261:C267")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("H2")) = True Then
Worksheets("Investor Data").range("H5").copy Worksheets("Data Base").range("C268:C274")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("H2")) = True Then
Worksheets("Investor Data").range("H6").copy Worksheets("Data Base").range("C275:C281")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("H2")) = True Then
Worksheets("Investor Data").range("H7").copy Worksheets("Data Base").range("C282:C288")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("H2")) = True Then
Worksheets("Investor Data").range("H8").copy Worksheets("Data Base").range("C289:C295")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("H2")) = True Then
Worksheets("Investor Data").range("H9").copy Worksheets("Data Base").range("C296:C302")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("H2")) = True Then
Worksheets("Investor Data").range("H10").copy Worksheets("Data Base").range("C303:C309")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("H2")) = True Then
Worksheets("Investor Data").range("H11").copy Worksheets("Data Base").range("C310:C316")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("H2")) = True Then
Worksheets("Investor Data").range("H12").copy Worksheets("Data Base").range("C317:C323")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("H2")) = True Then
Worksheets("Investor Data").range("H13").copy Worksheets("Data Base").range("C324:C330")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("I2")) = True Then
Worksheets("Investor Data").range("I2").copy Worksheets("Data Base").range("B331")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("I2")) = True Then
Worksheets("Investor Data").range("I3").copy Worksheets("Data Base").range("C331:C337")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("I2")) = True Then
Worksheets("Investor Data").range("I4").copy Worksheets("Data Base").range("C338:C344")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("I2")) = True Then
Worksheets("Investor Data").range("I5").copy Worksheets("Data Base").range("C345:C351")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("J2")) = True Then
Worksheets("Investor Data").range("J2").copy Worksheets("Data Base").range("B352")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("J2")) = True Then
Worksheets("Investor Data").range("J3").copy Worksheets("Data Base").range("C352:C358")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("J2")) = True Then
Worksheets("Investor Data").range("J4").copy Worksheets("Data Base").range("C359:C365")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("J2")) = True Then
Worksheets("Investor Data").range("J5").copy Worksheets("Data Base").range("C366:C372")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("J2")) = True Then
Worksheets("Investor Data").range("J6").copy Worksheets("Data Base").range("C373:C379")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("J2")) = True Then
Worksheets("Investor Data").range("J7").copy Worksheets("Data Base").range("C380:C386")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("J2")) = True Then
Worksheets("Investor Data").range("J8").copy Worksheets("Data Base").range("C387:C393")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("K2")) = True Then
Worksheets("Investor Data").range("K2").copy Worksheets("Data Base").range("B394")
End If

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("K2")) = True Then
Worksheets("Investor Data").range("K3").copy Worksheets("Data Base").range("C394:C400")
End If


If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("K2")) = True Then
Worksheets("Investor Data").range("K4").copy Worksheets("Data Base").range("C401:C407")
End If


If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("K2")) = True Then
Worksheets("Investor Data").range("K5").copy Worksheets("Data Base").range("C408:C414")
End If


If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("K2")) = True Then
Worksheets("Investor Data").range("K6").copy Worksheets("Data Base").range("C415:C421")
End If


If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("K2")) = True Then
Worksheets("Investor Data").range("K7").copy Worksheets("Data Base").range("C422:C428")
End If


If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("K2")) = True Then
Worksheets("Investor Data").range("K8").copy Worksheets("Data Base").range("C429:C435")
End If


If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("K2")) = True Then
Worksheets("Investor Data").range("K9").copy Worksheets("Data Base").range("C436:C442")
End If


If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("K2")) = True Then
Worksheets("Investor Data").range("K10").copy Worksheets("Data Base").range("C443:C449")
End If


If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("K2")) = True Then
Worksheets("Investor Data").range("K11").copy Worksheets("Data Base").range("C450:C456")
End If


If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("L2")) = True Then
Worksheets("Investor Data").range("L2").copy Worksheets("Data Base").range("B457")
End If


If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("K2")) = True Then
Worksheets("Investor Data").range("L3").copy Worksheets("Data Base").range("C457:C463")
End If


If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("K2")) = True Then
Worksheets("Investor Data").range("L4").copy Worksheets("Data Base").range("C464:C470")
End If


If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("K2")) = True Then
Worksheets("Investor Data").range("L5").copy Worksheets("Data Base").range("C471:C477")
End If


If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("K2")) = True Then
Worksheets("Investor Data").range("L6").copy Worksheets("Data Base").range("C478:C484")
End If


If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("K2")) = True Then
Worksheets("Investor Data").range("L7").copy Worksheets("Data Base").range("C485:C491")
End If

End Sub

решение1

Во-первых, добро пожаловать.
Во-вторых, первое, чего вы могли бы легко избежать, это повторение одного и того же ifснова и снова.

Таким образом, вместо того, чтобы проверять If Application.WorksheetFunction.IsText(Worksheets("Investor Data").range("E2"))13 раз и каждый раз выполнять одно действие, вы можете просто проверить один раз и выполнить все 13 действий.

Затем, конечно, наступает та часть, о которой вы спрашиваете, циклирование.
Есть много мест, где можно почитать о том, как циклировать вещи разными способами, но пока у нас есть шаблон, мы можем сделать цикл.

Итак, для первой части, E2у вас может быть такой цикл;

If Application.WorksheetFunction.IsText(Worksheets("Investor Data").Range("E2")) = True Then
j = 114
For i = 3 To 15
    Worksheets("Investor Data").Range("E" & i).copy Worksheets("Data Base").Range("C" & j & ":C" & j + 6)
    j = j + 7
Next i
End If

Это будет выполнено в соответствии с E3-E15 for loop, путем замены номера строки на используемую переменную.(Заметка: разве вам не следует скопировать и E2?) Вероятно, есть еще более эффективные способы сделать это, но это пример простого цикла.

Поскольку количество строк в каждом столбце разное, мы не можем просто включить это в больший цикл и на этом закончить.

Вы можете сделать несколько меньших петель, но я оставляю это на ваше усмотрение. Удачи.

редактировать

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

Sub callCopy()

Dim startRow As Long
startRow = 114
Call copySub(startRow, "E", 15)
Call copySub(startRow, "F", 5)
Call copySub(startRow, "G", 6)
Call copySub(startRow, "H", 13)
Call copySub(startRow, "I", 5)
Call copySub(startRow, "J", 8)
Call copySub(startRow, "K", 11)
Call copySub(startRow, "L", 7)

End Sub

Эта первая подпрограмма вызывает вторую приватную подпрограмму. Это могла бы быть функция, но они используются, когда вы хотите что-то вернуть. Вместо этого мы используем приватную подпрограмму:

Private Sub copySub(startRow As Long, iCol As String, iRows As Long)
Dim i As Long
If Application.WorksheetFunction.IsText(Worksheets("Investor Data").Range(iCol & "2")) = True Then
For i = 2 To iRows
    Worksheets("Investor Data").Range(iCol & i).copy Worksheets("Data Base").Range("C" & startRow & ":C" & startRow + 6)
    startRow = startRow + 7
Next i
End If

End Sub

Вторая подпрограмма — это всего лишь мой первый пример, но с большим количеством переменных. Затем они устанавливаются в скобках при вызове подпрограммы.
Я заменил фиксированные числа для столбца C в базе данных на переменную, поэтому вычисления будут проще. Но вы можете просто изменить их на фиксированное число при вызове, если это больше подходит для ваших нужд.

Связанный контент