Здравствуйте уважаемые форумчане. В приложенном файле-примере два столбца данных. Необходимо сформировать массив в котором в порядке возрастания расположены элементы первого столбца, причем только по одному разу, например "122259";"122791" и т.д. при чем в массив должны попасть только те данные, во втором столбце у которых содержится "с-т" и солд.". Решение должно быть без использования циклов. Спасибо.
Здравствуйте уважаемые форумчане. В приложенном файле-примере два столбца данных. Необходимо сформировать массив в котором в порядке возрастания расположены элементы первого столбца, причем только по одному разу, например "122259";"122791" и т.д. при чем в массив должны попасть только те данные, во втором столбце у которых содержится "с-т" и солд.". Решение должно быть без использования циклов. Спасибо.Sashagor1982
в принципе - можно на SQL запрос написать... вот только я не понял - строки 71 и 72 должны обе попасть или только какая-то одна? если одна - то какая именно и почему?
в принципе - можно на SQL запрос написать... вот только я не понял - строки 71 и 72 должны обе попасть или только какая-то одна? если одна - то какая именно и почему?ikki
помощь по Excel и VBA ikki@fxmail.ru, icq 592842413, skype alex.ikki
Сообщение отредактировал ikki - Среда, 03.06.2015, 22:19
Sashagor1982, здравствуйте. Без циклов, так без циклов
[vba]
Код
Sub list_fin() Application.ScreenUpdating = False Columns("D:E").ClearContents lr = Cells(Rows.Count, 1).End(xlUp).Row With ActiveSheet If .AutoFilterMode = True Then Cells.AutoFilter With .Range("A1:B" & lr) .AutoFilter Field:=2, Criteria1:="=солд.", _ Operator:=xlOr, Criteria2:="=с-т" .Copy [d1] End With .ShowAllData With .Range("D1:E" & lr) .Value = .Value .RemoveDuplicates Columns:=Array(1, 2) End With .Sort.SortFields.Clear .Sort.SortFields.Add Key:=Range("D1"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With .Sort .SetRange Range("D1:E" & lr) .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End With If [e1] <> "солд." And [e1] <> "с-т" Then Range("D1:E1").Delete Shift:=xlUp Application.ScreenUpdating = True End Sub
[/vba]
наверное код можно подсократить (пользовалась макрорекордером)
[p.s.]По замечанию Александра ( ikki), если значения в А одинаковые, а в В разные, то при выполнении остальных условий у меня попадут обе строки (в файле розовым выделены)[/p.s.]
Sashagor1982, здравствуйте. Без циклов, так без циклов
[vba]
Код
Sub list_fin() Application.ScreenUpdating = False Columns("D:E").ClearContents lr = Cells(Rows.Count, 1).End(xlUp).Row With ActiveSheet If .AutoFilterMode = True Then Cells.AutoFilter With .Range("A1:B" & lr) .AutoFilter Field:=2, Criteria1:="=солд.", _ Operator:=xlOr, Criteria2:="=с-т" .Copy [d1] End With .ShowAllData With .Range("D1:E" & lr) .Value = .Value .RemoveDuplicates Columns:=Array(1, 2) End With .Sort.SortFields.Clear .Sort.SortFields.Add Key:=Range("D1"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With .Sort .SetRange Range("D1:E" & lr) .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End With If [e1] <> "солд." And [e1] <> "с-т" Then Range("D1:E1").Delete Shift:=xlUp Application.ScreenUpdating = True End Sub
[/vba]
наверное код можно подсократить (пользовалась макрорекордером)
[p.s.]По замечанию Александра ( ikki), если значения в А одинаковые, а в В разные, то при выполнении остальных условий у меня попадут обе строки (в файле розовым выделены)[/p.s.]Manyasha
Manyasha, , то есть без вывода на экран результат не получить? Можно сделать какой-нибудь массив например Rezultat, который будет содержать данные столбца D?
Manyasha, , то есть без вывода на экран результат не получить? Можно сделать какой-нибудь массив например Rezultat, который будет содержать данные столбца D?Sashagor1982
Sub tt() Dim a(), i&, c As New Collection, x$ Dim ii&, j&, k&
a = [a1].CurrentRegion.Value For i = 1 To UBound(a) If InStr("с-т|солд.", a(i, 2)) > 0 Then x = a(i, 1) If c.Count = 0 Then c.Add x ElseIf c.Item(1) > x Then c.Add x, Before:=1 ElseIf c.Item(c.Count) < x Then c.Add x Else ii = 1 j = c.Count Do While ii < j k = ii + (j - ii) \ 2 If c.Item(k) >= x Then j = k Else ii = k + 1 Loop If c.Item(ii) > x Then c.Add x, Before:=ii End If
End If Next
'тут перебор коллекции - это можно сказать массив данных, уже сортированный For i = 1 To c.Count Debug.Print c(i) Next End Sub
[/vba]
Через коллекции, но циклы, циклы, циклы... [vba]
Код
Option Explicit
Sub tt() Dim a(), i&, c As New Collection, x$ Dim ii&, j&, k&
a = [a1].CurrentRegion.Value For i = 1 To UBound(a) If InStr("с-т|солд.", a(i, 2)) > 0 Then x = a(i, 1) If c.Count = 0 Then c.Add x ElseIf c.Item(1) > x Then c.Add x, Before:=1 ElseIf c.Item(c.Count) < x Then c.Add x Else ii = 1 j = c.Count Do While ii < j k = ii + (j - ii) \ 2 If c.Item(k) >= x Then j = k Else ii = k + 1 Loop If c.Item(ii) > x Then c.Add x, Before:=ii End If
End If Next
'тут перебор коллекции - это можно сказать массив данных, уже сортированный For i = 1 To c.Count Debug.Print c(i) Next End Sub
В готовых решениях я когда-то выкладывал функцию. Заменил в ней пол строки Так?
У Вас в списке есть числа и текст как числа - если их нужно сбить в одно нужно поменять одну строку: [vba]
Код
If Not dic.Exists(mas(i, ii)) And Not Trim(mas(i, ii)) = "" Then dic.Add mas(i, ii), i на If Not dic.Exists(CStr(mas(i, ii))) And Not Trim(mas(i, ii)) = "" Then dic.Add CStr(mas(i, ii)), i
[/vba] см. 2-й файл
В готовых решениях я когда-то выкладывал функцию. Заменил в ней пол строки Так?
У Вас в списке есть числа и текст как числа - если их нужно сбить в одно нужно поменять одну строку: [vba]
Код
If Not dic.Exists(mas(i, ii)) And Not Trim(mas(i, ii)) = "" Then dic.Add mas(i, ii), i на If Not dic.Exists(CStr(mas(i, ii))) And Not Trim(mas(i, ii)) = "" Then dic.Add CStr(mas(i, ii)), i
SLAVICK, да, именно - словарь здесь самый удобный вариант, поскольку имеет метод .exists Ну а сортировку можно в конце и встроенную использовать.
Впрочем, предложенный Мариной вариант - похоже, самый оптимальный по затратам Программирования-то он не требует... Ручками: включили автофильтр, отобрали строчки по второму столбцу, скопировали, сделали "Удалить дубликаты", сделали сортировку...
SLAVICK, да, именно - словарь здесь самый удобный вариант, поскольку имеет метод .exists Ну а сортировку можно в конце и встроенную использовать.
Впрочем, предложенный Мариной вариант - похоже, самый оптимальный по затратам Программирования-то он не требует... Ручками: включили автофильтр, отобрали строчки по второму столбцу, скопировали, сделали "Удалить дубликаты", сделали сортировку...AndreTM
то есть без вывода на экран результат не получить? Можно сделать какой-нибудь массив например Rezultat,
На сколько я понимаю ТС нужно получить данные без вывода на лист... наверное для дальнейшей обработки. А с функцией это легко можно сделать(ну или переделать ее немного под свои нужды)
Hugo - у Вас попадают и кода с пустыми значениями- наверное из-за : [vba]
то есть без вывода на экран результат не получить? Можно сделать какой-нибудь массив например Rezultat,
На сколько я понимаю ТС нужно получить данные без вывода на лист... наверное для дальнейшей обработки. А с функцией это легко можно сделать(ну или переделать ее немного под свои нужды)
Hugo - у Вас попадают и кода с пустыми значениями- наверное из-за : [vba]
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
