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

Вход

Регистрация

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

 

= Мир MS Excel/Выбор данных по условию с сортировкой - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выбор данных по условию с сортировкой (Макросы/Sub)
Выбор данных по условию с сортировкой
CHEVRYACHOK Дата: Среда, 14.03.2018, 08:20 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 96
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Доброе утро всем!
Не знаю возможно ли это сделать, но постараюсь объяснить.
Подскажите как макросом выбрать данные из таблицы по такому принципу
В столбцах А В С есть номера актов, в столбце Е название работ, в N Q T дата их выполнения
Как выбрать данные в два столбца на новом листе, только там где есть номер акта, таким образом
если в А есть номер, то первый столбик - АОСР (название из столбца Е этой строки), второй - № (который в А от дата из N)
если в B есть номер, то первый столбик - АОСР (название из столбца Е этой строки), второй - № (который в B от дата из Q)
если в C есть номер, то первый столбик - АОСР (название из столбца Е этой строки), второй - № (который в C от дата из T)
и все это посортировать по номеру акта.
На листе Результат привел пример, как должно получиться.
Думаю, там более понятно, чем мое описание )))
К сообщению приложен файл: 0129018.xlsx(20.5 Kb)
 
Ответить
СообщениеДоброе утро всем!
Не знаю возможно ли это сделать, но постараюсь объяснить.
Подскажите как макросом выбрать данные из таблицы по такому принципу
В столбцах А В С есть номера актов, в столбце Е название работ, в N Q T дата их выполнения
Как выбрать данные в два столбца на новом листе, только там где есть номер акта, таким образом
если в А есть номер, то первый столбик - АОСР (название из столбца Е этой строки), второй - № (который в А от дата из N)
если в B есть номер, то первый столбик - АОСР (название из столбца Е этой строки), второй - № (который в B от дата из Q)
если в C есть номер, то первый столбик - АОСР (название из столбца Е этой строки), второй - № (который в C от дата из T)
и все это посортировать по номеру акта.
На листе Результат привел пример, как должно получиться.
Думаю, там более понятно, чем мое описание )))

Автор - CHEVRYACHOK
Дата добавления - 14.03.2018 в 08:20
sboy Дата: Среда, 14.03.2018, 10:24 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 1872
Репутация: 552 ±
Замечаний: 0% ±

Excel 2010
Добрый день.
[vba]
Код
Sub chevryachok()
Dim arr()
Application.ScreenUpdating = False
    For q = 1 To 3
        ilr = WorksheetFunction.Max(Cells(Rows.Count, q).End(xlUp).Row, ilr)
    Next
    qount = WorksheetFunction.Count(Range("A4:C" & ilr))
    ReDim arr(1 To qount, 1 To 3)
    i = 1
    For r = 4 To ilr
        For j = 1 To 3
            If Not IsEmpty(Cells(r, j)) Then
                arr(i, 1) = "АОСР (" & Cells(r, 5) & ")"
                arr(i, 2) = "№" & Cells(r, j) & " от " & Cells(r, j).Offset(0, 11 + 2 * j)
                arr(i, 3) = Cells(r, j)
                i = i + 1
            End If
        Next j
    Next r
                
    With Sheets(2)
        .Cells(1).CurrentRegion.Clear
        Set res = .Cells(1).Resize(qount, 3)
        res.Value = arr
            With .Sort
                .SortFields.Add Key:=Range("C:C"), SortOn:=xlSortOnValues
                .SetRange res
                .Header = xlGuess
                .Orientation = xlTopToBottom
                .Apply
            End With
        .Columns(3).Delete
        Application.ScreenUpdating = True
        .Activate
    End With
End Sub
[/vba]
К сообщению приложен файл: 0129018.xlsm(30.9 Kb)


Сообщение отредактировал sboy - Среда, 14.03.2018, 10:37
 
Ответить
СообщениеДобрый день.
[vba]
Код
Sub chevryachok()
Dim arr()
Application.ScreenUpdating = False
    For q = 1 To 3
        ilr = WorksheetFunction.Max(Cells(Rows.Count, q).End(xlUp).Row, ilr)
    Next
    qount = WorksheetFunction.Count(Range("A4:C" & ilr))
    ReDim arr(1 To qount, 1 To 3)
    i = 1
    For r = 4 To ilr
        For j = 1 To 3
            If Not IsEmpty(Cells(r, j)) Then
                arr(i, 1) = "АОСР (" & Cells(r, 5) & ")"
                arr(i, 2) = "№" & Cells(r, j) & " от " & Cells(r, j).Offset(0, 11 + 2 * j)
                arr(i, 3) = Cells(r, j)
                i = i + 1
            End If
        Next j
    Next r
                
    With Sheets(2)
        .Cells(1).CurrentRegion.Clear
        Set res = .Cells(1).Resize(qount, 3)
        res.Value = arr
            With .Sort
                .SortFields.Add Key:=Range("C:C"), SortOn:=xlSortOnValues
                .SetRange res
                .Header = xlGuess
                .Orientation = xlTopToBottom
                .Apply
            End With
        .Columns(3).Delete
        Application.ScreenUpdating = True
        .Activate
    End With
End Sub
[/vba]

Автор - sboy
Дата добавления - 14.03.2018 в 10:24
Gustav Дата: Среда, 14.03.2018, 11:10 | Сообщение № 3
Группа: Друзья
Ранг: Старожил
Сообщений: 1587
Репутация: 634 ±
Замечаний: 0% ±

начинал с Excel 4.0...
Тоже поучаствую. Составной оператор с использованием SQL и ADO для безпроцедурного исполнения в Окне отладки Редактора VB:
[vba]
Код
Set rst = CreateObject("ADODB.Recordset"): _
rst.Open "SELECT 'АОСР (' & B & ')', '№ ' & A & ' от ' & C FROM ( " _
& "SELECT CLng(F1) AS A, F5 AS B, CDate(F14) AS C FROM ( " _
& "SELECT F1,F5,F14 FROM [Реестр$A4:T1000] WHERE F1 Is Not Null " _
& "UNION ALL SELECT F2,F5,F17 FROM [Реестр$A4:T1000] WHERE F2 Is Not Null " _
& "UNION ALL SELECT F3,F5,F20 FROM [Реестр$A4:T1000] WHERE F3 Is Not Null " _
& ") ORDER BY 1 )", _
"Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& ThisWorkbook.FullName & _
";Extended Properties='Excel 12.0;HDR=No'": _
[Результат!A1].CopyFromRecordset rst
[/vba]
Копируете в Окно отладки, встаете в конец последней строки и жмете Enter.


Мой tip box - яд 41001663842605
 
Ответить
СообщениеТоже поучаствую. Составной оператор с использованием SQL и ADO для безпроцедурного исполнения в Окне отладки Редактора VB:
[vba]
Код
Set rst = CreateObject("ADODB.Recordset"): _
rst.Open "SELECT 'АОСР (' & B & ')', '№ ' & A & ' от ' & C FROM ( " _
& "SELECT CLng(F1) AS A, F5 AS B, CDate(F14) AS C FROM ( " _
& "SELECT F1,F5,F14 FROM [Реестр$A4:T1000] WHERE F1 Is Not Null " _
& "UNION ALL SELECT F2,F5,F17 FROM [Реестр$A4:T1000] WHERE F2 Is Not Null " _
& "UNION ALL SELECT F3,F5,F20 FROM [Реестр$A4:T1000] WHERE F3 Is Not Null " _
& ") ORDER BY 1 )", _
"Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& ThisWorkbook.FullName & _
";Extended Properties='Excel 12.0;HDR=No'": _
[Результат!A1].CopyFromRecordset rst
[/vba]
Копируете в Окно отладки, встаете в конец последней строки и жмете Enter.

Автор - Gustav
Дата добавления - 14.03.2018 в 11:10
CHEVRYACHOK Дата: Среда, 14.03.2018, 13:22 | Сообщение № 4
Группа: Пользователи
Ранг: Участник
Сообщений: 96
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
sboy, Gustav,
Спасибо огромное! Все работает hands

Gustav, скажите, а такой способ к кнопочке можно привязать или только копированием в окно?
 
Ответить
Сообщениеsboy, Gustav,
Спасибо огромное! Все работает hands

Gustav, скажите, а такой способ к кнопочке можно привязать или только копированием в окно?

Автор - CHEVRYACHOK
Дата добавления - 14.03.2018 в 13:22
Gustav Дата: Среда, 14.03.2018, 13:58 | Сообщение № 5
Группа: Друзья
Ранг: Старожил
Сообщений: 1587
Репутация: 634 ±
Замечаний: 0% ±

начинал с Excel 4.0...
такой способ к кнопочке можно привязать?

Конечно, можно. С минимальными усилиями будет примерно так:
[vba]
Код
Private Sub CommandButton1_Click()

Dim rst As Object

'и сюда вставляете вышеприведенный "моноблок" для Окна отладки
'................................................

End Sub
[/vba]

[p.s.]Чисто больше даже для себя в качестве узелка на память - еще один вариант "моноблока" - с одним вложенным SELECTом вместо двух, а также с эффективным использованием функций VBA внутри запроса: [/p.s.]

[vba]
Код
Set rst = CreateObject("ADODB.Recordset"): _
rst.Open "SELECT 'АОСР (' & F5 & ')', '№ ' & F1 & ' от ' & Format(F14, 'dd.mm.yyyy') FROM ( " _
& "SELECT F1,F5,F14 FROM [Реестр$A4:T1000] WHERE F1 Is Not Null UNION ALL " _
& "SELECT F2,F5,F17 FROM [Реестр$A4:T1000] WHERE F2 Is Not Null UNION ALL " _
& "SELECT F3,F5,F20 FROM [Реестр$A4:T1000] WHERE F3 Is Not Null " _
& ") ORDER BY CLng(F1)", _
"Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& ThisWorkbook.FullName & _
";Extended Properties='Excel 12.0;HDR=No'": _
[Результат!A1].CopyFromRecordset rst
[/vba]


Мой tip box - яд 41001663842605

Сообщение отредактировал Gustav - Среда, 14.03.2018, 14:25
 
Ответить
Сообщение
такой способ к кнопочке можно привязать?

Конечно, можно. С минимальными усилиями будет примерно так:
[vba]
Код
Private Sub CommandButton1_Click()

Dim rst As Object

'и сюда вставляете вышеприведенный "моноблок" для Окна отладки
'................................................

End Sub
[/vba]

[p.s.]Чисто больше даже для себя в качестве узелка на память - еще один вариант "моноблока" - с одним вложенным SELECTом вместо двух, а также с эффективным использованием функций VBA внутри запроса: [/p.s.]

[vba]
Код
Set rst = CreateObject("ADODB.Recordset"): _
rst.Open "SELECT 'АОСР (' & F5 & ')', '№ ' & F1 & ' от ' & Format(F14, 'dd.mm.yyyy') FROM ( " _
& "SELECT F1,F5,F14 FROM [Реестр$A4:T1000] WHERE F1 Is Not Null UNION ALL " _
& "SELECT F2,F5,F17 FROM [Реестр$A4:T1000] WHERE F2 Is Not Null UNION ALL " _
& "SELECT F3,F5,F20 FROM [Реестр$A4:T1000] WHERE F3 Is Not Null " _
& ") ORDER BY CLng(F1)", _
"Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& ThisWorkbook.FullName & _
";Extended Properties='Excel 12.0;HDR=No'": _
[Результат!A1].CopyFromRecordset rst
[/vba]

Автор - Gustav
Дата добавления - 14.03.2018 в 13:58
CHEVRYACHOK Дата: Среда, 14.03.2018, 14:27 | Сообщение № 6
Группа: Пользователи
Ранг: Участник
Сообщений: 96
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Gustav, еще раз благодарю!
 
Ответить
СообщениеGustav, еще раз благодарю!

Автор - CHEVRYACHOK
Дата добавления - 14.03.2018 в 14:27
Gustav Дата: Среда, 14.03.2018, 15:21 | Сообщение № 7
Группа: Друзья
Ранг: Старожил
Сообщений: 1587
Репутация: 634 ±
Замечаний: 0% ±

начинал с Excel 4.0...
Не за что! Мне по кайфу дёргать данные Excel при помощи SQL :)

В догонку ещё один кейсик - процедура для кнопки без объявления переменной рекордсета (rst):
[vba]
Код
Private Sub CommandButton1_Click()

With CreateObject("ADODB.Recordset")
    .Open "SELECT 'АОСР (' & F5 & ')', '№ ' & F1 & ' от ' & Format(F14, 'dd.mm.yyyy') FROM ( " _
    & "SELECT F1,F5,F14 FROM [Реестр$A4:T1000] WHERE F1 Is Not Null UNION ALL " _
    & "SELECT F2,F5,F17 FROM [Реестр$A4:T1000] WHERE F2 Is Not Null UNION ALL " _
    & "SELECT F3,F5,F20 FROM [Реестр$A4:T1000] WHERE F3 Is Not Null " _
    & ") ORDER BY CLng(F1)", _
    "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
    & ThisWorkbook.FullName & _
    ";Extended Properties='Excel 12.0;HDR=No'"
    
    [Результат!A1].CopyFromRecordset .DataSource
End With

End Sub
[/vba]


Мой tip box - яд 41001663842605
 
Ответить
СообщениеНе за что! Мне по кайфу дёргать данные Excel при помощи SQL :)

В догонку ещё один кейсик - процедура для кнопки без объявления переменной рекордсета (rst):
[vba]
Код
Private Sub CommandButton1_Click()

With CreateObject("ADODB.Recordset")
    .Open "SELECT 'АОСР (' & F5 & ')', '№ ' & F1 & ' от ' & Format(F14, 'dd.mm.yyyy') FROM ( " _
    & "SELECT F1,F5,F14 FROM [Реестр$A4:T1000] WHERE F1 Is Not Null UNION ALL " _
    & "SELECT F2,F5,F17 FROM [Реестр$A4:T1000] WHERE F2 Is Not Null UNION ALL " _
    & "SELECT F3,F5,F20 FROM [Реестр$A4:T1000] WHERE F3 Is Not Null " _
    & ") ORDER BY CLng(F1)", _
    "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
    & ThisWorkbook.FullName & _
    ";Extended Properties='Excel 12.0;HDR=No'"
    
    [Результат!A1].CopyFromRecordset .DataSource
End With

End Sub
[/vba]

Автор - Gustav
Дата добавления - 14.03.2018 в 15:21
CHEVRYACHOK Дата: Среда, 14.03.2018, 16:47 | Сообщение № 8
Группа: Пользователи
Ранг: Участник
Сообщений: 96
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Gustav, все работает!!! Подскажите, а как будет выглядеть блок, если делать, только по первому столбцу без 2-го и 3-го?
 
Ответить
СообщениеGustav, все работает!!! Подскажите, а как будет выглядеть блок, если делать, только по первому столбцу без 2-го и 3-го?

Автор - CHEVRYACHOK
Дата добавления - 14.03.2018 в 16:47
Gustav Дата: Среда, 14.03.2018, 18:36 | Сообщение № 9
Группа: Друзья
Ранг: Старожил
Сообщений: 1587
Репутация: 634 ±
Замечаний: 0% ±

начинал с Excel 4.0...
как будет выглядеть блок, если

Давайте я покажу версию с Вашими заголовками полей (а не с безликими умолчательными F1-F20) и, думаю, всё более-менее прояснится:
[vba]
Код
Private Sub CommandButton1_Click()

With CreateObject("ADODB.Recordset")
    .Open "SELECT 'АОСР (' & [Наименование работ] & ')', '№ ' & [Номер акта] & ' от ' & Format([Дата акта], 'dd.mm.yyyy') FROM ( " _
    & "SELECT [Номер акта] ,[Наименование работ],[Дата акта]  FROM [Реестр$A3:T1000] WHERE [Номер акта]  Is Not Null UNION ALL " _
    & "SELECT [Номер акта1],[Наименование работ],[Дата акта1] FROM [Реестр$A3:T1000] WHERE [Номер акта1] Is Not Null UNION ALL " _
    & "SELECT [Номер акта2],[Наименование работ],[Дата акта2] FROM [Реестр$A3:T1000] WHERE [Номер акта2] Is Not Null " _
    & ") ORDER BY CLng([Номер акта])", _
    "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
    & ThisWorkbook.FullName & _
    ";Extended Properties='Excel 12.0;HDR=Yes'"
    
    [Результат!A1].CopyFromRecordset .DataSource
End With

End Sub
[/vba]
Обращаю внимание, что диапазон выборки теперь начинается со строки 3 (а не 4) и параметр HDR=Yes. А также на то, что общие заголовки полей внутреннего SELECT наследуются от первого SELECT из трёх, объединенных при помощи UNION.

[p.s.]Если же хотите делать выборку без 2-го и 3-го только по колонкам A, E и N, то запрос значительно упрощается: [/p.s.]

[vba]
Код
Private Sub CommandButton1_Click()

With CreateObject("ADODB.Recordset")
    .Open "SELECT 'АОСР (' & [Наименование работ] & ')', '№ ' & [Номер акта] & ' от ' & Format([Дата акта], 'dd.mm.yyyy') " _
    & "FROM [Реестр$A3:T1000] WHERE [Номер акта] Is Not Null ORDER BY CLng([Номер акта])", _
    "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
    & ThisWorkbook.FullName & _
    ";Extended Properties='Excel 12.0;HDR=Yes'"
    
    [Результат!A1].CopyFromRecordset .DataSource
End With

End Sub
[/vba]


Мой tip box - яд 41001663842605

Сообщение отредактировал Gustav - Среда, 14.03.2018, 18:57
 
Ответить
Сообщение
как будет выглядеть блок, если

Давайте я покажу версию с Вашими заголовками полей (а не с безликими умолчательными F1-F20) и, думаю, всё более-менее прояснится:
[vba]
Код
Private Sub CommandButton1_Click()

With CreateObject("ADODB.Recordset")
    .Open "SELECT 'АОСР (' & [Наименование работ] & ')', '№ ' & [Номер акта] & ' от ' & Format([Дата акта], 'dd.mm.yyyy') FROM ( " _
    & "SELECT [Номер акта] ,[Наименование работ],[Дата акта]  FROM [Реестр$A3:T1000] WHERE [Номер акта]  Is Not Null UNION ALL " _
    & "SELECT [Номер акта1],[Наименование работ],[Дата акта1] FROM [Реестр$A3:T1000] WHERE [Номер акта1] Is Not Null UNION ALL " _
    & "SELECT [Номер акта2],[Наименование работ],[Дата акта2] FROM [Реестр$A3:T1000] WHERE [Номер акта2] Is Not Null " _
    & ") ORDER BY CLng([Номер акта])", _
    "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
    & ThisWorkbook.FullName & _
    ";Extended Properties='Excel 12.0;HDR=Yes'"
    
    [Результат!A1].CopyFromRecordset .DataSource
End With

End Sub
[/vba]
Обращаю внимание, что диапазон выборки теперь начинается со строки 3 (а не 4) и параметр HDR=Yes. А также на то, что общие заголовки полей внутреннего SELECT наследуются от первого SELECT из трёх, объединенных при помощи UNION.

[p.s.]Если же хотите делать выборку без 2-го и 3-го только по колонкам A, E и N, то запрос значительно упрощается: [/p.s.]

[vba]
Код
Private Sub CommandButton1_Click()

With CreateObject("ADODB.Recordset")
    .Open "SELECT 'АОСР (' & [Наименование работ] & ')', '№ ' & [Номер акта] & ' от ' & Format([Дата акта], 'dd.mm.yyyy') " _
    & "FROM [Реестр$A3:T1000] WHERE [Номер акта] Is Not Null ORDER BY CLng([Номер акта])", _
    "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
    & ThisWorkbook.FullName & _
    ";Extended Properties='Excel 12.0;HDR=Yes'"
    
    [Результат!A1].CopyFromRecordset .DataSource
End With

End Sub
[/vba]

Автор - Gustav
Дата добавления - 14.03.2018 в 18:36
CHEVRYACHOK Дата: Четверг, 15.03.2018, 07:46 | Сообщение № 10
Группа: Пользователи
Ранг: Участник
Сообщений: 96
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Gustav, спасибо! hands Оч круто, попробую применить к другим вариантам
 
Ответить
СообщениеGustav, спасибо! hands Оч круто, попробую применить к другим вариантам

Автор - CHEVRYACHOK
Дата добавления - 15.03.2018 в 07:46
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выбор данных по условию с сортировкой (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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