Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Копирование строк по столбцу ища одинаковые значения - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование строк по столбцу ища одинаковые значения (Макросы/Sub)
Копирование строк по столбцу ища одинаковые значения
den45444 Дата: Четверг, 08.09.2016, 15:30 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 225
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Есть код, который находит одинаковые значения, но копирует последовательно
[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
Дата добавления - 08.09.2016 в 15:30
Manyasha Дата: Четверг, 08.09.2016, 16:11 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
den45444, пример покажите? Что там за данные?
находит одинаковые значения

в Вашем макросе копируются только строки с единичками, так и надо?


ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеden45444, пример покажите? Что там за данные?
находит одинаковые значения

в Вашем макросе копируются только строки с единичками, так и надо?

Автор - Manyasha
Дата добавления - 08.09.2016 в 16:11
Hugo Дата: Четверг, 08.09.2016, 16:29 | Сообщение № 3
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3250
Репутация: 707 ±
Замечаний: 0% ±

2019
скопировать все строки со значением "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))

    End Select
Next

copyra.Copy
[/vba]


excel@nxt.ru
webmoney: E265281470651 Z422237915069


Сообщение отредактировал Hugo - Четверг, 08.09.2016, 16:36
 
Ответить
Сообщение
скопировать все строки со значением "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))

    End Select
Next

copyra.Copy
[/vba]

Автор - Hugo
Дата добавления - 08.09.2016 в 16:29
den45444 Дата: Четверг, 08.09.2016, 17:27 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 225
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Hugo, то что надо. Благодарю за подсказку.
А как вставить все это со сдвигом вниз? Так Insert Shift:=xlDown не получается
 
Ответить
СообщениеHugo, то что надо. Благодарю за подсказку.
А как вставить все это со сдвигом вниз? Так Insert Shift:=xlDown не получается

Автор - den45444
Дата добавления - 08.09.2016 в 17:27
KuklP Дата: Четверг, 08.09.2016, 17:54 | Сообщение № 5
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
И не получится. Вставляйте простой вставкой ниже существующего диапазона.


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеИ не получится. Вставляйте простой вставкой ниже существующего диапазона.

Автор - KuklP
Дата добавления - 08.09.2016 в 17:54
den45444 Дата: Четверг, 08.09.2016, 18:01 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 225
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
И не получится. Вставляйте простой вставкой ниже существующего диапазона.

Получается мне нужно определить кол-во строк со значением "1" -- вставить пустые строки -- потом только вставлять скопированные строки?
И еще вопрос: при добавлении еще несколько значений по порядку до 6-и через for k=1 To 6 вставляет повторно строки которые были скопированы при значении "1". Не могу понять почему
 
Ответить
Сообщение
И не получится. Вставляйте простой вставкой ниже существующего диапазона.

Получается мне нужно определить кол-во строк со значением "1" -- вставить пустые строки -- потом только вставлять скопированные строки?
И еще вопрос: при добавлении еще несколько значений по порядку до 6-и через for k=1 To 6 вставляет повторно строки которые были скопированы при значении "1". Не могу понять почему

Автор - den45444
Дата добавления - 08.09.2016 в 18:01
den45444 Дата: Четверг, 08.09.2016, 18:07 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 225
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
вот так пытаюсь шесть раз провести копирование, но что все сбивается со 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]

Автор - den45444
Дата добавления - 08.09.2016 в 18:07
den45444 Дата: Четверг, 08.09.2016, 18:20 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 225
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
пример покажите? Что там за данные?

набросал пример, может чего-то не хватает, но думаю будет понятно что нужно сделать
К сообщению приложен файл: 0580016.xlsm (12.3 Kb)
 
Ответить
Сообщение
пример покажите? Что там за данные?

набросал пример, может чего-то не хватает, но думаю будет понятно что нужно сделать

Автор - den45444
Дата добавления - 08.09.2016 в 18:20
KuklP Дата: Четверг, 08.09.2016, 21:04 | Сообщение № 9
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Не очень понятно. Нафига нам файл с запароленными листами?
Я имел ввиду это:
[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]А потом отсортировать. Только зачем? Можно сразу все вниз скопировать и отсортировать. Результат будет тот же.


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеНе очень понятно. Нафига нам файл с запароленными листами?
Я имел ввиду это:
[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
Дата добавления - 08.09.2016 в 21:04
den45444 Дата: Четверг, 08.09.2016, 21:14 | Сообщение № 10
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 225
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Нафига нам файл с запароленными листами?

Прошу прощения
К сообщению приложен файл: 7101029.xlsm (12.2 Kb)
 
Ответить
Сообщение
Нафига нам файл с запароленными листами?

Прошу прощения

Автор - den45444
Дата добавления - 08.09.2016 в 21:14
den45444 Дата: Четверг, 08.09.2016, 21:25 | Сообщение № 11
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 225
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Можно сразу все вниз скопировать и отсортировать

Мне же нужно между строк вставить скопированные строки. Например, строка Этап_1 и над ней нужно вставить все скопированные строки со значением "1" со сдвигом всех строк вниз и так 6 раз пробежаться
 
Ответить
Сообщение
Можно сразу все вниз скопировать и отсортировать

Мне же нужно между строк вставить скопированные строки. Например, строка Этап_1 и над ней нужно вставить все скопированные строки со значением "1" со сдвигом всех строк вниз и так 6 раз пробежаться

Автор - den45444
Дата добавления - 08.09.2016 в 21:25
KuklP Дата: Четверг, 08.09.2016, 22:13 | Сообщение № 12
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Не знаю, мож так:
[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
[/vba]


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеНе знаю, мож так:
[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
[/vba]

Автор - KuklP
Дата добавления - 08.09.2016 в 22:13
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование строк по столбцу ища одинаковые значения (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!