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

Вход

Регистрация

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

 

= Мир MS Excel/поиск строки по двум значениям - Мир MS Excel

Старая форма входа
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » поиск строки по двум значениям (Макросы/Sub)
поиск строки по двум значениям
Sashagor1982 Дата: Четверг, 18.02.2016, 19:48 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 287
Репутация: -6 ±
Замечаний: 0% ±

Excel 2007
Здравствуйте форумчане. Подскажите пожалуйста можно ли как-нибудь без обычного перебора циклом найти на листе строку и поместить ее в массив если значение в столбце d равно переменной numer, а в столбце w переменной podr. При этом содержимое листа никак не должно изменяться.
[vba]
Код
set numer="5", podr="упр."
[/vba]
На листе имеется только одна строка отвечающая данным требованиям. Заранее спасибо,


Сообщение отредактировал Sashagor1982 - Четверг, 18.02.2016, 19:49
 
Ответить
СообщениеЗдравствуйте форумчане. Подскажите пожалуйста можно ли как-нибудь без обычного перебора циклом найти на листе строку и поместить ее в массив если значение в столбце d равно переменной numer, а в столбце w переменной podr. При этом содержимое листа никак не должно изменяться.
[vba]
Код
set numer="5", podr="упр."
[/vba]
На листе имеется только одна строка отвечающая данным требованиям. Заранее спасибо,

Автор - Sashagor1982
Дата добавления - 18.02.2016 в 19:48
nilem Дата: Четверг, 18.02.2016, 21:24 | Сообщение № 2
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
наверное, только если Find
Find - Find Next по столбцу d и проверять значение в ст w


Яндекс.Деньги 4100159601573
 
Ответить
Сообщениенаверное, только если Find
Find - Find Next по столбцу d и проверять значение в ст w

Автор - nilem
Дата добавления - 18.02.2016 в 21:24
Апострофф Дата: Четверг, 18.02.2016, 22:06 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 444
Репутация: 122 ±
Замечаний: 0% ±

Excel 1997
Или совсем без цикла-
[vba]
Код
Sub Макрос3()
    Cells.AutoFilter Field:=1, Criteria1:="5"
    Cells.AutoFilter Field:=20, Criteria1:="упр."
    Dim v
    ActiveSheet.UsedRange.Copy
    Sheets.Add
    ActiveSheet.Paste
    v = ActiveSheet.UsedRange.Rows(2).Value
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
    Cells.AutoFilter
End Sub
[/vba]
 
Ответить
СообщениеИли совсем без цикла-
[vba]
Код
Sub Макрос3()
    Cells.AutoFilter Field:=1, Criteria1:="5"
    Cells.AutoFilter Field:=20, Criteria1:="упр."
    Dim v
    ActiveSheet.UsedRange.Copy
    Sheets.Add
    ActiveSheet.Paste
    v = ActiveSheet.UsedRange.Rows(2).Value
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
    Cells.AutoFilter
End Sub
[/vba]

Автор - Апострофф
Дата добавления - 18.02.2016 в 22:06
Sashagor1982 Дата: Четверг, 18.02.2016, 22:11 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 287
Репутация: -6 ±
Замечаний: 0% ±

Excel 2007
Да, совсем без цикла наверное не получится. Просто с циклом for...next слишком долго получается.
 
Ответить
СообщениеДа, совсем без цикла наверное не получится. Просто с циклом for...next слишком долго получается.

Автор - Sashagor1982
Дата добавления - 18.02.2016 в 22:11
Апострофф Дата: Четверг, 18.02.2016, 22:15 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 444
Репутация: 122 ±
Замечаний: 0% ±

Excel 1997
Получилось же -
Цитата Апострофф, 18.02.2016 в 22:06, в сообщении № 3
Sub Макрос3()
или нет?
 
Ответить
СообщениеПолучилось же -
Цитата Апострофф, 18.02.2016 в 22:06, в сообщении № 3
Sub Макрос3()
или нет?

Автор - Апострофф
Дата добавления - 18.02.2016 в 22:15
Sashagor1982 Дата: Четверг, 18.02.2016, 22:18 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 287
Репутация: -6 ±
Замечаний: 0% ±

Excel 2007
С фильтрами не подойдет, т.к работать должно с другого листа.
 
Ответить
СообщениеС фильтрами не подойдет, т.к работать должно с другого листа.

Автор - Sashagor1982
Дата добавления - 18.02.2016 в 22:18
Апострофф Дата: Четверг, 18.02.2016, 22:25 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 444
Репутация: 122 ±
Замечаний: 0% ±

Excel 1997
не подойдет, т.к работать должно с другого листа
Это действительно проблема :'(

Извините, что занял своим бредом Ваше драгоценное время.


Сообщение отредактировал Апострофф - Четверг, 18.02.2016, 23:03
 
Ответить
Сообщение
не подойдет, т.к работать должно с другого листа
Это действительно проблема :'(

Извините, что занял своим бредом Ваше драгоценное время.

Автор - Апострофф
Дата добавления - 18.02.2016 в 22:25
Sashagor1982 Дата: Четверг, 18.02.2016, 23:20 | Сообщение № 8
Группа: Проверенные
Ранг: Обитатель
Сообщений: 287
Репутация: -6 ±
Замечаний: 0% ±

Excel 2007
С совпадением двух значений только одна.
 
Ответить
СообщениеС совпадением двух значений только одна.

Автор - Sashagor1982
Дата добавления - 18.02.2016 в 23:20
Sashagor1982 Дата: Пятница, 19.02.2016, 06:49 | Сообщение № 9
Группа: Проверенные
Ранг: Обитатель
Сообщений: 287
Репутация: -6 ±
Замечаний: 0% ±

Excel 2007
Разное может быть, так 2000.
 
Ответить
СообщениеРазное может быть, так 2000.

Автор - Sashagor1982
Дата добавления - 19.02.2016 в 06:49
Апострофф Дата: Пятница, 19.02.2016, 07:39 | Сообщение № 10
Группа: Проверенные
Ранг: Обитатель
Сообщений: 444
Репутация: 122 ±
Замечаний: 0% ±

Excel 1997
С фильтрами не подойдет, т.к работать должно с другого листа.

Разрешите ещё раз побеспокоить -
[vba]
Код
Function Sashagor(WS As Worksheet, Field, Criteria)
For i = 0 To UBound(Field)
  WS.Cells.AutoFilter Field(i), Criteria(i)
Next
Sashagor = WS.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(2).Value
WS.Cells.AutoFilter
End Function

Sub Example()
c1 = [d:d].Column: c2 = [w:w].Column
numer = "5": podr = "упр."
v = Sashagor(Worksheets("Лист1"), Array(c1, c2), Array(numer, podr))
MsgBox v(1, 4) & " | " & v(1, 23)
End Sub
[/vba]Что на сей раз не так?
 
Ответить
Сообщение
С фильтрами не подойдет, т.к работать должно с другого листа.

Разрешите ещё раз побеспокоить -
[vba]
Код
Function Sashagor(WS As Worksheet, Field, Criteria)
For i = 0 To UBound(Field)
  WS.Cells.AutoFilter Field(i), Criteria(i)
Next
Sashagor = WS.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(2).Value
WS.Cells.AutoFilter
End Function

Sub Example()
c1 = [d:d].Column: c2 = [w:w].Column
numer = "5": podr = "упр."
v = Sashagor(Worksheets("Лист1"), Array(c1, c2), Array(numer, podr))
MsgBox v(1, 4) & " | " & v(1, 23)
End Sub
[/vba]Что на сей раз не так?

Автор - Апострофф
Дата добавления - 19.02.2016 в 07:39
Sashagor1982 Дата: Пятница, 19.02.2016, 09:20 | Сообщение № 11
Группа: Проверенные
Ранг: Обитатель
Сообщений: 287
Репутация: -6 ±
Замечаний: 0% ±

Excel 2007
Пустые значения выдает.
 
Ответить
СообщениеПустые значения выдает.

Автор - Sashagor1982
Дата добавления - 19.02.2016 в 09:20
Апострофф Дата: Пятница, 19.02.2016, 09:23 | Сообщение № 12
Группа: Проверенные
Ранг: Обитатель
Сообщений: 444
Репутация: 122 ±
Замечаний: 0% ±

Excel 1997
Пример приведите (в виде файла), пожалуйста.
 
Ответить
СообщениеПример приведите (в виде файла), пожалуйста.

Автор - Апострофф
Дата добавления - 19.02.2016 в 09:23
Manyasha Дата: Пятница, 19.02.2016, 10:51 | Сообщение № 13
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
Sashagor1982,
с циклом for...next слишком долго
а если сначала в массив все?
[vba]
Код
Sub еее()
    numer = 5
    podr = "упр."
    With Sheets(1) 'указать свой лист
        lr = .Cells(Rows.Count, "d").End(xlUp).Row
        Dim rng, arr(), i&, k&
        rng = .Range("d1:w" & lr).Value
        For i = 1 To lr
            If rng(i, 1) = numer And rng(i, UBound(rng, 2)) = podr Then
                ReDim Preserve arr(k)
                arr(k) = Intersect(.Rows(i), .UsedRange).Value: k = k + 1
            End If
        Next i
    End With
    'Вывод на 2-й лист
    For i = 0 To UBound(arr)
        Sheets(2).Cells(i + 1, 1).Resize(, UBound(arr(i), 2)) = arr(i)
    Next i
End Sub
[/vba]


ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеSashagor1982,
с циклом for...next слишком долго
а если сначала в массив все?
[vba]
Код
Sub еее()
    numer = 5
    podr = "упр."
    With Sheets(1) 'указать свой лист
        lr = .Cells(Rows.Count, "d").End(xlUp).Row
        Dim rng, arr(), i&, k&
        rng = .Range("d1:w" & lr).Value
        For i = 1 To lr
            If rng(i, 1) = numer And rng(i, UBound(rng, 2)) = podr Then
                ReDim Preserve arr(k)
                arr(k) = Intersect(.Rows(i), .UsedRange).Value: k = k + 1
            End If
        Next i
    End With
    'Вывод на 2-й лист
    For i = 0 To UBound(arr)
        Sheets(2).Cells(i + 1, 1).Resize(, UBound(arr(i), 2)) = arr(i)
    Next i
End Sub
[/vba]

Автор - Manyasha
Дата добавления - 19.02.2016 в 10:51
_Boroda_ Дата: Пятница, 19.02.2016, 10:53 | Сообщение № 14
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
А вот такой вариант? Хоть и с циклом, но на 20 000 работает моментально
[vba]
Код
Sub tt()
    ar1 = Range("D2:D20000")
    ar2 = Range("W2:W20000")
    For i = LBound(ar1) To UBound(ar1)
        ar1(i, 1) = ar1(i, 1) & ar2(i, 1)
    Next i
    n_ = WorksheetFunction.Match("5упр.", ar1, 0) + 1
End Sub
[/vba]
Дает номер строки. Что Вы с этой строкой потом делать хотите - я не знаю.

Во, Маняша тоже с массивом поиграться решила.


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеА вот такой вариант? Хоть и с циклом, но на 20 000 работает моментально
[vba]
Код
Sub tt()
    ar1 = Range("D2:D20000")
    ar2 = Range("W2:W20000")
    For i = LBound(ar1) To UBound(ar1)
        ar1(i, 1) = ar1(i, 1) & ar2(i, 1)
    Next i
    n_ = WorksheetFunction.Match("5упр.", ar1, 0) + 1
End Sub
[/vba]
Дает номер строки. Что Вы с этой строкой потом делать хотите - я не знаю.

Во, Маняша тоже с массивом поиграться решила.

Автор - _Boroda_
Дата добавления - 19.02.2016 в 10:53
Sashagor1982 Дата: Пятница, 19.02.2016, 13:39 | Сообщение № 15
Группа: Проверенные
Ранг: Обитатель
Сообщений: 287
Репутация: -6 ±
Замечаний: 0% ±

Excel 2007
Выдает ошибку 1004 невможно получить свойство Match....
[moder]Вы бы пример согласно правил приложили бы.
Уже давно бы решили свой вопрос.[/moder]


Сообщение отредактировал SLAVICK - Пятница, 19.02.2016, 14:09
 
Ответить
СообщениеВыдает ошибку 1004 невможно получить свойство Match....
[moder]Вы бы пример согласно правил приложили бы.
Уже давно бы решили свой вопрос.[/moder]

Автор - Sashagor1982
Дата добавления - 19.02.2016 в 13:39
StoTisteg Дата: Воскресенье, 21.02.2016, 01:18 | Сообщение № 16
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
А что вообще нужно на выходе? Если сама строка, то что-то мне подсказывает, что AdvancedFilter спасёт отца русской демократии.


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
СообщениеА что вообще нужно на выходе? Если сама строка, то что-то мне подсказывает, что AdvancedFilter спасёт отца русской демократии.

Автор - StoTisteg
Дата добавления - 21.02.2016 в 01:18
StoTisteg Дата: Воскресенье, 21.02.2016, 01:43 | Сообщение № 17
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
[vba]
Код

    Dim col, rws As Integer
    
    col = ActiveSheet.UsedRange.Columns.Count
    rws = ActiveSheet.UsedRange.Rows.Count
    Cells(1, 4).Copy Destination:=Cells(1, col + 2)
    Cells(2, col + 2).Value = numer
    Cells(1, 23).Copy Destination:=Cells(1, col + 3)
    Cells(2, col + 3).Value = podr
    Range(Cells(1, 1), Cells(rws, col)).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(Cells(1, col + 2), Cells(2, col + 3)), CopyToRange:=Cells(1, col + 5), Unique:=False
[/vba]
В столбцах col+5 — 2*col+5 имеете искомое (вместе с заголовками), с коим можете делать что угодно.


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
Сообщение[vba]
Код

    Dim col, rws As Integer
    
    col = ActiveSheet.UsedRange.Columns.Count
    rws = ActiveSheet.UsedRange.Rows.Count
    Cells(1, 4).Copy Destination:=Cells(1, col + 2)
    Cells(2, col + 2).Value = numer
    Cells(1, 23).Copy Destination:=Cells(1, col + 3)
    Cells(2, col + 3).Value = podr
    Range(Cells(1, 1), Cells(rws, col)).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(Cells(1, col + 2), Cells(2, col + 3)), CopyToRange:=Cells(1, col + 5), Unique:=False
[/vba]
В столбцах col+5 — 2*col+5 имеете искомое (вместе с заголовками), с коим можете делать что угодно.

Автор - StoTisteg
Дата добавления - 21.02.2016 в 01:43
StoTisteg Дата: Воскресенье, 21.02.2016, 02:01 | Сообщение № 18
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
Например, скопипастить на новый лист:

[vba]
Код

    Dim list As String

    list = ActiveSheet.Name
    Sheets.Add After:=Sheets(Sheets.Count)
    Worksheets(list).Range(Cells(1, col + 5), Cells(Cells(Rows.Count, col + 8).End(xlUp).Row, 2 * col + 5)).Copy Destination:=Cells(1, 1)
[/vba]


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
СообщениеНапример, скопипастить на новый лист:

[vba]
Код

    Dim list As String

    list = ActiveSheet.Name
    Sheets.Add After:=Sheets(Sheets.Count)
    Worksheets(list).Range(Cells(1, col + 5), Cells(Cells(Rows.Count, col + 8).End(xlUp).Row, 2 * col + 5)).Copy Destination:=Cells(1, 1)
[/vba]

Автор - StoTisteg
Дата добавления - 21.02.2016 в 02:01
StoTisteg Дата: Воскресенье, 21.02.2016, 16:08 | Сообщение № 19
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
А лучше всего сначала перенести, потом фильтровать:
[vba]
Код

    Dim list As String
    Dim col, rws, i As Integer

    list = ActiveSheet.Name
    Sheets.Add After:=Sheets(Sheets.Count)
    Worksheets(list).Cells.Copy Destination:=ActiveSheet.Cells
    col = ActiveSheet.UsedRange.Columns.Count
    rws = ActiveSheet.UsedRange.Rows.Count
    Cells(1, 4).Copy Destination:=Cells(1, col + 2)
    Cells(2, col + 2).Value = numer
    Cells(1, 23).Copy Destination:=Cells(1, col + 3)
    Cells(2, col + 3).Value = podr
    Range(Cells(1, 1), Cells(rws, col)).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(Cells(1, col + 2), Cells(2, col + 3)), CopyToRange:=Cells(1, col + 5), Unique:=False
    For i = 1 To col + 4
        Columns(1).Delete
    Next i
[/vba]


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
СообщениеА лучше всего сначала перенести, потом фильтровать:
[vba]
Код

    Dim list As String
    Dim col, rws, i As Integer

    list = ActiveSheet.Name
    Sheets.Add After:=Sheets(Sheets.Count)
    Worksheets(list).Cells.Copy Destination:=ActiveSheet.Cells
    col = ActiveSheet.UsedRange.Columns.Count
    rws = ActiveSheet.UsedRange.Rows.Count
    Cells(1, 4).Copy Destination:=Cells(1, col + 2)
    Cells(2, col + 2).Value = numer
    Cells(1, 23).Copy Destination:=Cells(1, col + 3)
    Cells(2, col + 3).Value = podr
    Range(Cells(1, 1), Cells(rws, col)).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(Cells(1, col + 2), Cells(2, col + 3)), CopyToRange:=Cells(1, col + 5), Unique:=False
    For i = 1 To col + 4
        Columns(1).Delete
    Next i
[/vba]

Автор - StoTisteg
Дата добавления - 21.02.2016 в 16:08
Sashagor1982 Дата: Воскресенье, 21.02.2016, 17:30 | Сообщение № 20
Группа: Проверенные
Ранг: Обитатель
Сообщений: 287
Репутация: -6 ±
Замечаний: 0% ±

Excel 2007
Извиняюсь так как не могу прилагать примеры на выходе нужен номер строки в которой значения в столбцах соответствуют заданным. Фильтр и циклы желательно не использовать.
 
Ответить
СообщениеИзвиняюсь так как не могу прилагать примеры на выходе нужен номер строки в которой значения в столбцах соответствуют заданным. Фильтр и циклы желательно не использовать.

Автор - Sashagor1982
Дата добавления - 21.02.2016 в 17:30
Мир MS Excel » Вопросы и решения » Вопросы по VBA » поиск строки по двум значениям (Макросы/Sub)
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

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