Новости:

Новая редакция правил форума: 2.4. Если вопрос или ответ содержится во вложенном файле, все-равно кратко описывайте в сообщении вопрос или суть решения. Это необходимо, чтобы тему можно было найти через поиск.

Главное меню

Макрос, отображающий значения из таблицы

Автор Barbarian12, 18.05.2012, 12:10

« назад - далее »

Barbarian12

Добрый день!

Помогите, пожалуйста, составить макрос, делающий следующее:
Есть две большие таблицы, дебиторская и кредиторская задолженность. Данные у таблиц примерно одинаковые: сумма, контрагент, дата и т.д. Необходимо составить макрос, который в одной таблице отображал всю задолженность контрагента из другой таблицы. Я это вижу примерно так: выделяю ячейку J2 из "таблицы 1" вложенного файла, нажимаю комбинацию клавиш, запускающий макрос, который осуществляет поиск значения ячейки Н1 в столбце D "таблицы 2". Поиск должен происходить по частичному совпадению. Если совпадении находится, то макрос выводит диалоговое окно (желательно, чтобы из него можно было копировать значения, но за неимением сойдет и msgbox), где отображается все строки с найденными значениями.

Например, при поиске ячейки Н7 ("ИКСТРИМ"), выводилось следующее:
0531687757   01.06.2010   31.05.2011   ООО "ИКСТРИМ"   1584.000   RUR   0.000   1584.000
0531687966   22.07.2010   21.07.2011   ООО "ИКСТРИМ"   3956.750   RUR   0.000   3956.750
Т.е. вся строка целиком. Закрываю диалоговое окно и со следующей ячейки макрос запускается заново.

Спасибо.

shamilganiev

вот попробуй без макросов пока что

Hugo121

#2
Можно так попробовать:


Sub Macro1()
   Columns("K:R").ClearContents

   With Sheets(2)
       Dim Rng As Range
       .[D:D].AutoFilter Field:=1, Criteria1:="=*" & Selection.Value & "*"
       Set Rng = .UsedRange.SpecialCells(xlCellTypeVisible)
       Intersect(Rng, .Columns("A:H")).Copy [k2]
       .[D:D].AutoFilter
   End With
End Sub


Только сперва на втором листе добавьте сверху строку с заголовками или хотя бы с пробелом в D1.

Да, рассчитано на то, что в момент запуска активна ячейка с критерием (например "ИКСТРИМ")
webmoney: E265281470651 Z422237915069

Barbarian12

Цитата: Hugo121 от 18.05.2012, 13:14
Можно так попробовать:

Только сперва на втором листе добавьте сверху строку с заголовками или хотя бы с пробелом в D1.

Да, рассчитано на то, что в момент запуска активна ячейка с критерием (например "ИКСТРИМ")
Спасибо. Парочка замечаний:
- Нужно, чтобы данные начинали отображаться не со строки 2, а с той же строки, из которой осуществляется поиск. Т.е. если искомое значение находится в строке 152, то и значений из таблицы должны отображаться с ячейки К152;
- При каждом поиске сейчас отображается вторая строка, что неверно (см. пример);
- При следующем запуске макроса, предыдущие результаты поиска должны удаляться.

Poltava

То ли файл битый то ли еще чего в общем у меня не открылся точнее открылся но девственно чистым!
Не пытайтесь спорить с дебилом. Иначе вы опуститесь до его уровня. Где он задавит вас своим опытом.

Hugo121

#5
- Нужно, чтобы данные начинали отображаться не со строки 2, а с той же строки, из которой осуществляется поиск. Т.е. если искомое значение находится в строке 152, то и значений из таблицы должны отображаться с ячейки К152;
Option Explicit

Sub Macro1()
   Columns("K:R").ClearContents

   With Sheets(2)
       Dim Rng As Range
       .[D:D].AutoFilter Field:=1, Criteria1:="=*" & Selection.Value & "*"
       Set Rng = .UsedRange.SpecialCells(xlCellTypeVisible)
       Intersect(Rng, .Columns("A:H")).Copy Cells(ActiveCell.Row, "k")
       .[D:D].AutoFilter
   End With
End Sub

- При каждом поиске сейчас отображается вторая строка, что неверно (см. пример);
Только сперва на втором листе добавьте сверху строку с заголовками или хотя бы с пробелом в D1.
- При следующем запуске макроса, предыдущие результаты поиска должны удаляться.
Columns("K:R").ClearContents - как Вы думаете, это что делает?

И у меня тоже не открылся Задолженность19.xls
webmoney: E265281470651 Z422237915069

Barbarian12

Hugo121, спасибо! Сначала написал, а потом посмотрел, что все работает.
И последний вопрос: как сделать, чтобы значения искались в двух столбцах: D и Е?

Hugo121

Sub Macro2()
    Columns("K:R").ClearContents

    With Sheets(2)
        With .[D:E]
            .AutoFilter 1, "=*" & Selection.Value & "*"
            .AutoFilter 2, ">1600"
        End With

        Intersect(.UsedRange.SpecialCells(xlCellTypeVisible), _
        .Columns("A:H")).Copy Cells(ActiveCell.Row, "k")
        .[D:E].AutoFilter
    End With
End Sub


Как будете задавать второй параметр - это уже следующий вопрос. А последний уже был :)
webmoney: E265281470651 Z422237915069