Давайте так - Вы показываете в файле исходные данные и какой должен быть результат, а мы (не обязательно я) пишем код это выполняющий. Потому что я сомневаюсь что нужно именно "вытаскивать все неповторяющиеся строки". А писать коды зазря - интереса нет. Да и времени жалко.
Давайте так - Вы показываете в файле исходные данные и какой должен быть результат, а мы (не обязательно я) пишем код это выполняющий. Потому что я сомневаюсь что нужно именно "вытаскивать все неповторяющиеся строки". А писать коды зазря - интереса нет. Да и времени жалко.Hugo
anofilis, добрый вечер,к сожалению Вы не указали,как Вам надо на листе Дебиторка(сообщение от Hugo:#22),на словах не совсем понятно,добавил Вам кнопку tt для макроса от Hugo и протестируйте кнопку test1,так ли Вам надо для сообщения #23.Возможно у Hugo появится время и он предложит свой оригинальный вариант...
[vba]
Код
Sub test1() Dim z, i&, j&, m&: z = Sheets("Сводная объекты").Range("A3:I" & Sheets("Сводная объекты").Range("A" & Rows.Count).End(xlUp).Row).Value: m = 1 With CreateObject("scripting.dictionary"): .comparemode = 1 For i = 1 To UBound(z): .Item(z(i, 7)) = .Item(z(i, 7)) + 1: Next For i = 2 To UBound(z) If .Item(z(i, 7)) = 1 Then m = m + 1: For j = 1 To UBound(z, 2): z(m, j) = z(i, j): Next End If Next Sheets("Дебиторка").Range("A1").Resize(m, UBound(z, 2) - 1).Value = z End With Sheets("Дебиторка").Columns("A:H").AutoFit: Sheets("Дебиторка").Columns("A:C").Delete Sheets("Дебиторка").Columns("C:D").Delete End Sub
[/vba]
anofilis, добрый вечер,к сожалению Вы не указали,как Вам надо на листе Дебиторка(сообщение от Hugo:#22),на словах не совсем понятно,добавил Вам кнопку tt для макроса от Hugo и протестируйте кнопку test1,так ли Вам надо для сообщения #23.Возможно у Hugo появится время и он предложит свой оригинальный вариант...
[vba]
Код
Sub test1() Dim z, i&, j&, m&: z = Sheets("Сводная объекты").Range("A3:I" & Sheets("Сводная объекты").Range("A" & Rows.Count).End(xlUp).Row).Value: m = 1 With CreateObject("scripting.dictionary"): .comparemode = 1 For i = 1 To UBound(z): .Item(z(i, 7)) = .Item(z(i, 7)) + 1: Next For i = 2 To UBound(z) If .Item(z(i, 7)) = 1 Then m = m + 1: For j = 1 To UBound(z, 2): z(m, j) = z(i, j): Next End If Next Sheets("Дебиторка").Range("A1").Resize(m, UBound(z, 2) - 1).Value = z End With Sheets("Дебиторка").Columns("A:H").AutoFit: Sheets("Дебиторка").Columns("A:C").Delete Sheets("Дебиторка").Columns("C:D").Delete End Sub
Не, я подожду пока прояснится задача. 50% - маловато, а вернее я бы дал 80% что не нужно отбирать "все неповторяющиеся строки", а нужно отобрать все без повторов. Но кто его знает... P.S. Хотя в общем всё уже есть в коде уважаемого sv2014, просто один цикл выкинуть, а второй чуть дополнить. [vba]
Код
Sub test1() Dim z, i&, j&, m&: z = Sheets("Сводная объекты").Range("A3:I" & Sheets("Сводная объекты").Range("A" & Rows.Count).End(xlUp).Row).Value: m = 1 With CreateObject("scripting.dictionary"): .comparemode = 1 ' For i = 1 To UBound(z): .Item(z(i, 7)) = .Item(z(i, 7)) + 1: Next 'убрали For i = 2 To UBound(z) .Item(z(i, 7)) = .Item(z(i, 7)) + 1 'добавили If .Item(z(i, 7)) = 1 Then m = m + 1: For j = 1 To UBound(z, 2): z(m, j) = z(i, j): Next End If Next Sheets("Дебиторка").Range("A1").Resize(m, UBound(z, 2) - 1).Value = z End With Sheets("Дебиторка").Columns("A:H").AutoFit: Sheets("Дебиторка").Columns("A:C").Delete Sheets("Дебиторка").Columns("C:D").Delete End Sub
[/vba]
Не, я подожду пока прояснится задача. 50% - маловато, а вернее я бы дал 80% что не нужно отбирать "все неповторяющиеся строки", а нужно отобрать все без повторов. Но кто его знает... P.S. Хотя в общем всё уже есть в коде уважаемого sv2014, просто один цикл выкинуть, а второй чуть дополнить. [vba]
Код
Sub test1() Dim z, i&, j&, m&: z = Sheets("Сводная объекты").Range("A3:I" & Sheets("Сводная объекты").Range("A" & Rows.Count).End(xlUp).Row).Value: m = 1 With CreateObject("scripting.dictionary"): .comparemode = 1 ' For i = 1 To UBound(z): .Item(z(i, 7)) = .Item(z(i, 7)) + 1: Next 'убрали For i = 2 To UBound(z) .Item(z(i, 7)) = .Item(z(i, 7)) + 1 'добавили If .Item(z(i, 7)) = 1 Then m = m + 1: For j = 1 To UBound(z, 2): z(m, j) = z(i, j): Next End If Next Sheets("Дебиторка").Range("A1").Resize(m, UBound(z, 2) - 1).Value = z End With Sheets("Дебиторка").Columns("A:H").AutoFit: Sheets("Дебиторка").Columns("A:C").Delete Sheets("Дебиторка").Columns("C:D").Delete End Sub
Hugo, Друзья еще раз.мне нужно копировать все неповторяющиеся строки т.е все без повторов реализовать хотелось бы при помощи кнопки ну и если возможно то в макросе возможность выбора отображения столбцов.
Hugo, Друзья еще раз.мне нужно копировать все неповторяющиеся строки т.е все без повторов реализовать хотелось бы при помощи кнопки ну и если возможно то в макросе возможность выбора отображения столбцов.anofilis
anofilis, У Вам есть три разных кода (даже четыре, но два выдают одинаковый результат) - берите какой угодно. Желательно мою последнюю модификацию кода sv2014 - я похоже угадал :) А чтоб не гадать и не растягивать бодягу на две страницы - нужен сразу пример файла согласно правилам! А фраза "все неповторяющиеся строки т.е все без повторов" - это оксюморон
anofilis, У Вам есть три разных кода (даже четыре, но два выдают одинаковый результат) - берите какой угодно. Желательно мою последнюю модификацию кода sv2014 - я похоже угадал :) А чтоб не гадать и не растягивать бодягу на две страницы - нужен сразу пример файла согласно правилам! А фраза "все неповторяющиеся строки т.е все без повторов" - это оксюморон Hugo