Есть код, который находит одинаковые значения, но копирует последовательно [vba]
Код
For i = 4 To Range("J" & .Rows.Count).End(xlUp).row Select Case .Cells(i, 10) Case "1" Rows(i).Copy '??? Rows(Range("этап_1").row).Insert Shift:=xlDown End Select Next
[/vba]
Как можно пройтись по столбцу J и скопировать все строки со значением "1" одним разом?
Есть код, который находит одинаковые значения, но копирует последовательно [vba]
Код
For i = 4 To Range("J" & .Rows.Count).End(xlUp).row Select Case .Cells(i, 10) Case "1" Rows(i).Copy '??? Rows(Range("этап_1").row).Insert Shift:=xlDown End Select Next
[/vba]
Как можно пройтись по столбцу J и скопировать все строки со значением "1" одним разом?den45444
скопировать все строки со значением "1" одним разом
- собираете диапазон в один объект с помощью Union, затем всё разом копируете. [vba]
Код
Dim copyra As Range
For i = 4 To Range("J" & .Rows.Count).End(xlUp).Row Select Case .Cells(i, 10) Case "1" If copyra Is Nothing Then Set copyra = .Rows(i) Else Set copyra = Union(copyra, .Rows(i))
скопировать все строки со значением "1" одним разом
- собираете диапазон в один объект с помощью Union, затем всё разом копируете. [vba]
Код
Dim copyra As Range
For i = 4 To Range("J" & .Rows.Count).End(xlUp).Row Select Case .Cells(i, 10) Case "1" If copyra Is Nothing Then Set copyra = .Rows(i) Else Set copyra = Union(copyra, .Rows(i))
И не получится. Вставляйте простой вставкой ниже существующего диапазона.
Получается мне нужно определить кол-во строк со значением "1" -- вставить пустые строки -- потом только вставлять скопированные строки? И еще вопрос: при добавлении еще несколько значений по порядку до 6-и через for k=1 To 6 вставляет повторно строки которые были скопированы при значении "1". Не могу понять почему
И не получится. Вставляйте простой вставкой ниже существующего диапазона.
Получается мне нужно определить кол-во строк со значением "1" -- вставить пустые строки -- потом только вставлять скопированные строки? И еще вопрос: при добавлении еще несколько значений по порядку до 6-и через for k=1 To 6 вставляет повторно строки которые были скопированы при значении "1". Не могу понять почемуden45444
вот так пытаюсь шесть раз провести копирование, но что все сбивается со 2-го значения i [vba]
Код
For i = 1 To 6 iKok = WorksheetFunction.CountIf(.Range(.Cells(1, 10), .Cells(400, 10)), i) .Range("этап_" & i).Resize(iKok).EntireRow.Insert For n = 4 To .Range("J" & .Rows.Count).End(xlUp).row Select Case .Cells(n, 10) Case i If copyra Is Nothing Then Set copyra = .Rows(n) Else Set copyra = Union(copyra, .Rows(n)) End Select Next n copyra.Copy .Rows(Range("этап_" & i).row - iKok) Next i
[/vba]
вот так пытаюсь шесть раз провести копирование, но что все сбивается со 2-го значения i [vba]
Код
For i = 1 To 6 iKok = WorksheetFunction.CountIf(.Range(.Cells(1, 10), .Cells(400, 10)), i) .Range("этап_" & i).Resize(iKok).EntireRow.Insert For n = 4 To .Range("J" & .Rows.Count).End(xlUp).row Select Case .Cells(n, 10) Case i If copyra Is Nothing Then Set copyra = .Rows(n) Else Set copyra = Union(copyra, .Rows(n)) End Select Next n copyra.Copy .Rows(Range("этап_" & i).row - iKok) Next i
Не очень понятно. Нафига нам файл с запароленными листами? Я имел ввиду это: [vba]
Код
For i = 1 To 6 iKok = WorksheetFunction.CountIf(Range(Cells(1, 10), Cells(400, 10)), i) For n = 4 To Range("J" & Rows.Count).End(xlUp).Row Select Case Cells(n, 10) Case i If copyra Is Nothing Then Set copyra = Rows(n) Else Set copyra = Union(copyra, Rows(n)) End Select Next n Intersect(copyra, Me.UsedRange).Copy Cells(Rows.Count, 1).End(xlUp)(2) Next i
[/vba]А потом отсортировать. Только зачем? Можно сразу все вниз скопировать и отсортировать. Результат будет тот же.
Не очень понятно. Нафига нам файл с запароленными листами? Я имел ввиду это: [vba]
Код
For i = 1 To 6 iKok = WorksheetFunction.CountIf(Range(Cells(1, 10), Cells(400, 10)), i) For n = 4 To Range("J" & Rows.Count).End(xlUp).Row Select Case Cells(n, 10) Case i If copyra Is Nothing Then Set copyra = Rows(n) Else Set copyra = Union(copyra, Rows(n)) End Select Next n Intersect(copyra, Me.UsedRange).Copy Cells(Rows.Count, 1).End(xlUp)(2) Next i
[/vba]А потом отсортировать. Только зачем? Можно сразу все вниз скопировать и отсортировать. Результат будет тот же.KuklP
Ну с НДС и мы чего-то стoим! kuklp60@gmail.com WM Z206653985942, R334086032478, U238399322728
Мне же нужно между строк вставить скопированные строки. Например, строка Этап_1 и над ней нужно вставить все скопированные строки со значением "1" со сдвигом всех строк вниз и так 6 раз пробежаться
Мне же нужно между строк вставить скопированные строки. Например, строка Этап_1 и над ней нужно вставить все скопированные строки со значением "1" со сдвигом всех строк вниз и так 6 раз пробежатьсяden45444
Public Sub www() Dim i&, n&, iKok&, copyra As Range, r As Range For i = 1 To 6 iKok = WorksheetFunction.CountIf(Range(Cells(1, 10), Cells(400, 10)), i) If iKok > 0 Then For n = 2 To Range("J" & Rows.Count).End(xlUp).Row Select Case Cells(n, 10) Case i If copyra Is Nothing Then Set copyra = Intersect(Me.UsedRange, Rows(n)) Set r = Cells(n, 1) Else Set copyra = Union(copyra, Intersect(Me.UsedRange, Rows(n))) Set r = Cells(n, 1) End If End Select Next n r(2).Resize(iKok).EntireRow.Insert copyra.Copy r(2) Set copyra = Nothing: Set r = Nothing End If Next i End Sub
[/vba]
Не знаю, мож так: [vba]
Код
Public Sub www() Dim i&, n&, iKok&, copyra As Range, r As Range For i = 1 To 6 iKok = WorksheetFunction.CountIf(Range(Cells(1, 10), Cells(400, 10)), i) If iKok > 0 Then For n = 2 To Range("J" & Rows.Count).End(xlUp).Row Select Case Cells(n, 10) Case i If copyra Is Nothing Then Set copyra = Intersect(Me.UsedRange, Rows(n)) Set r = Cells(n, 1) Else Set copyra = Union(copyra, Intersect(Me.UsedRange, Rows(n))) Set r = Cells(n, 1) End If End Select Next n r(2).Resize(iKok).EntireRow.Insert copyra.Copy r(2) Set copyra = Nothing: Set r = Nothing End If Next i End Sub