Я изо всех сил пытаюсь определить, что делает ваш код. Ниже я указываю некоторые упрощения и другие необходимые улучшения, но может быть больше, когда мы очистим хворост.
Изменить 1
Пожалуйста, используйте Option Explicit и, пожалуйста, объявите свои переменные. Это позволяет избежать принятия переменной опечатки в качестве нового неявного объявления.
Изменить 2
Пожалуйста, используйте Application.ScreenUpdating = False. Это позволяет избежать перекрашивания экрана, поскольку макрос выполняет свои задачи. Это было бы важно для вашего кода из-за всех переключений между листами. Это менее важно для моего кода, потому что я не переключаю листы.
Изменить 3
Заменить:
With Sheets("Sheet3")
:
Range("A1:G1").Select
Selection.Copy
Sheets("sheet4").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("sheet3").Select
:
End With
по:
With Sheets("Sheet3")
:
.Range("A1:G1").Copy Destination:=Worksheets("Sheet4").Range("A1")
:
End With
Это позволяет избежать переключения листов, что является самой большой тратой времени.
Изменить 4
Для каждого If-ElseIf-ElseIf-EndIf вы делаете одну и ту же копию. Итак:
If .Value = "Bin1" Or .Value = "Bin2" Or .Value = "Bin3" _
.Value = "Bin4" Or .Value = "Bin5" Then
будет иметь тот же эффект.
Сводка на данный момент
Я полагаю, что следующее делает точно так же, как ваш первый цикл:
Option Explicit
Sub Macro1()
Dim iCol As Long
Dim iRow As Long
Dim ValueCell as String
With Sheets("Sheet3")
For iCol = 1 To 1
For iRow = 1 To 1
ValueCell = .Cells(iRow, iCol).Value
If ValueCell = "Bin1" Or ValueCell = "Bin2" Or ValueCell = "Bin3" Or _
ValueCell = "Bin4" Or ValueCell = "Bin5" Then
.Range("A1:G1").Copy Destination:=Worksheets("Sheet4").Range("A1")
End If
Next
Next
End With
End Sub
Возможны дальнейшие изменения
Действительно ли циклы независимы? Для меня это выглядит так, как будто вы можете объединить их в один цикл.
Добавлен новый раздел в ответ на обмен комментариями
Считайте код в вашем вопросе:
- У вас есть шесть двойных петель.
- В каждом случае внешний цикл равен
For iCol = 1 to 1. То есть вы проверяете только столбец «А», хотя подразумеваете, что проверяли бы больше столбцов, если код был быстрее.
- Внутренний цикл -
For iRow = 1 to №. № 1 в первом цикле, 2 во втором и 6 в шестом цикле. Опять же, вы подразумеваете, что проверяли бы больше строк, если бы код был быстрее.
- Действие для каждого цикла зависит от значения №.
Таблица, показывающая эффект № действия:
Value
of № Cells examined Values checked for Range moved
1 A1 "Bin1" ... "Bin6" A1:G1
2 A1, A2 "Bin2" ... "Bin6" A2:G2
3 A1, A2, A3 "Bin3" ... "Bin6" A3:G3
4 A1, A2, ... A4 "Bin4" ... "Bin6" A4:G4
5 A1, A2, ... A5 "Bin5", "Bin6" A5:G5
6 A1, A2, ... A6 "Bin6" A6:G6
- То есть в двойном цикле № вы проверяете ячейки с A1 по A№, проверяете значения от "Bin№" до "Bin6" и, если найдено, копируете
Sheets("Sheet3").Range("A№:G№") в Sheets("Sheet4").Range("A№).
В ваших текстовых и примерных данных вы ссылаетесь на "text2" вместо "Bin2". Я не понимаю, что вы пытаетесь сделать. Ниже я представлю еще несколько VBA, которые могут помочь вам создать нужный код. Если этого не произойдет, вам придется добавить новый раздел в свой вопрос, объясняющий на английском языке, что вы пытаетесь сделать.
Новый синтаксис 1
Рассмотрим:
For iRow = 1 to 6
:
.Range("A6:G6").Copy Destination:=Worksheets("Sheet4").Range("A6")
:
Next
"A6:G6" и "A6" - строки, которые вы можете построить во время выполнения.
Теперь рассмотрим:
For iRow = 1 to iRowMax
:
.Range("A" & iRowMax & ":G" & iRowMax)).Copy _
Destination:=Worksheets("Sheet4").Range("A" & iRowMax)
:
Next
В соответствии со значением iRowMax это дает:
iRow Statement
1 .Range("A1:G1")).Copy Destination:=Worksheets("Sheet4").Range("A1")
2 .Range("A2:G2")).Copy Destination:=Worksheets("Sheet4").Range("A2")
3 .Range("A3:G3")).Copy Destination:=Worksheets("Sheet4").Range("A3")
Новый синтаксис 2
Другой способ изменить диапазон во время выполнения - заменить:
.Range(string)
с
.Range(.Cells(RowTop,ColLeft),.Cells(RowBottom,ColRight))
С помощью этого синтаксиса вы можете легко указать прямоугольник требуемого размера.
Новый синтаксис 3
Рассмотрим:
For i = 1 to 5
If this(i) = that Then
Do something fixed
Exit For
End If
Next
' Exit For statement jumps to here
В этом цикле я тестирую пять значений. Если есть совпадение, я что-то делаю. Если я получаю совпадение по первому значению, мне не нужно проверять другие значения. Exit For позволяет мне выпрыгнуть из цикла For-Loop. Если есть вложенные циклы For-Loops, Exit For выходит только из внутреннего цикла
Новый синтаксис 4
"Bin1", "Bin2" и т. Д. Также могут быть созданы во время выполнения.
iRowMax = 4
For iRow = 1 to iRowMax
For iBin = iRowMax to 6
If ValueCell = "Bin" & iBin Then
' Move Range
Exit For
End If
Next
' Exit For statement jumps to here
Next
При iRow = 4 внутренний цикл For-loop устанавливает iBin на 4, 5 и 6. Это устанавливает "Bin" & iBin на "Bin4", "Bin5" и "Bin6".
Итак:
For BinNum = iRowMax to 6
If ValueCell = "Bin" & BinNum Then
' Move Range
Exit For
End If
Next
совпадает с:
If ValueCell = "Bin4" Or ValueCell = "Bin5" Or ValueCell = "Bin6" Then
' Move Range
End If
Этот новый код сложнее и труднее для понимания, чем оригинал, но это может быть то, что вам нужно.
Резюме
Я показал вам разные способы изменения того, что происходит в зависимости от значения iRow. Я надеюсь, что один из них позволит вам построить рутину, которую вы хотите.
Я не проверял это, но я думаю, что это делает то же самое, что и все шесть циклов в вашем исходном коде:
Option Explicit
Sub Macro1()
Dim iBin as Long
Dim iCol As Long
Dim iRow As Long
Dim iRowMax as Long
Dim ValueCell as String
Application.ScreenUpdating = False
With Sheets("Sheet3")
For iRowMax = 1 to 6
For iCol = 1 To 1 ' This could be replaced by iCol = 1 at the top
For iRow = 1 To iRowMax
ValueCell = .Cells(iRow, iCol).Value
For iBin = iRowMax to 6
If ValueCell = "Bin" & iBin Then
.Range("A" & iRowMax & ":G" & iRowMax)).Copy _
Destination:=Worksheets("Sheet4").Range("A" & iRowMax)
End If
Next iBin
Next iRow
Next iCol
End With
End Sub
Примечание:только удаление всех операторов Select делает этот код быстрее, чем ваш. Другие изменения делают его меньше и немного медленнее, потому что у меня есть два дополнительных цикла For-Loops, и я строю строки во время выполнения.