Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Поиск по книге и суммирование значений, Макрос из указанного столбца производит поиск по всем листам книги и копирует на текущий лист значение в одной из соседних ячеек от найденного значения
 
#1
02.12.2023 19:26:50
Доброго времени суток!
Возникла необходимость с помощью макроса произвести поиск по книге, с определенными условиями:
1. Выбирается столбец с данными, которые поочередно нужно найти в книге.
2. Выбирается столбец для вставки значений.
3. При успешном поиске, необходимо значение в соседней ячейке (в моем случае - через 2 ячейки справа) скопировать на лист, с которого осуществляется выборка значений (п. 1), и вставить в ячейку в той строке, из которой идет поиск (номер столбца ячейки выбрали в п. 2).
4. Если искомое значение присутствует в книге несколько раз, то у каждой из найденных ячеек соседнее (или через 2 справа) значение суммировать и вставить на лист со столбцом, по которому идет поиск (по аналогии с п. 3).

Пока получилось организовать поиск (без суммирования) с копированием значений в ячейке через 2 справа. Но заполняет только первые 15 строк. При попытке суммировать - почему то некорректно считает.
Есть умельцы, кто подскажет решение вопроса?
 
 
 
#2
03.12.2023 05:22:26
Если структура листов одинаковая, то зачем пользователю выбирать столбец? Определите его сразу в коде, или, кодом-же, ищите нужный столбец по какому либо признаку (заголовку, формату данных и т.п.). То же и со столбцом для вставки.
Хотя это дело хозяйское, Вам виднее. Если это действительно нужно - допилите сами
См.файл
Скрытый текст

П.С.
Цитата
trovial написал:
Есть умельцы
Выглядит как 'на слабо'. Тут так не надо. Захотят - и так помогут, если задача интересная.
Изменено: Sanja - 03.12.2023 05:23:17
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
03.12.2023 06:17:01
Цитата
написал:
Если структура листов одинаковая, то зачем пользователю выбирать столбец?
Для данной задачи структура одинаковая. Предусматривал момент, когда нужно часть столбца проверить, а не весь целиком.
Да и будущем может что-то измениться, думал об универсальном решении... А может и что-то типа надстройки сделать.
Цитата
написал:
Выглядит как 'на слабо'. Тут так не надо.
Извините, не хотел вызвать подобной реакции.

А за решение - огромное спасибо!!!  
 
 
 
#4
03.12.2023 07:35:27
Вот такой код ищет столбец с нужным форматом данных и использует его в дальнейших вычислениях
Код
'..........................................
For Each iSh In ThisWorkbook.Worksheets
  If iSh.Name <> "000" Then
    With iSh
      For Each iCell In .UsedRange.Cells
        If iCell Like "*.*.*.*" Then
          iClmn = iCell.Column
          Exit For
        End If
      Next
      arr = .Range(.Cells(1, iClmn), .Cells(.Cells(.Rows.Count, iClmn).End(xlUp).Row, .Cells(1, .Columns.Count).End(xlToLeft).Column)).Value
'...........далее по тексту кода ............

То же самое для итогового столбца
Код
With Worksheets("000")
  For Each iCell In .UsedRange.Cells
    If iCell Like "*.*.*.*" Then
      iClmn = iCell.Column
      Exit For
    End If
  Next
  arr = .Range(.Cells(5, iClmn), .Cells(.Cells(.Rows.Count, iClmn).End(xlUp).Row, iClmn + 1)).Value
  For I = LBound(arr, 1) To UBound(arr, 1)
    If iDic.Exists(arr(I, 1)) Then
      arr(I, 2) = iDic(arr(I, 1))
    End If
  Next
  .Cells(5, iClmn + 1).Resize(UBound(arr, 1)) = Application.Index(arr, 0, 2)
End With
Изменено: Sanja - 03.12.2023 07:44:29
Согласие есть продукт при полном непротивлении сторон
 
 
 
#5
04.12.2023 05:36:41
Sanja, вижу, что в решении выше идет поиск по маске "х.х.х.х". А как быть, если  формат этих данных может принимать не только такой вид? В ячейке могут находиться значения следующих типов (1/1, 1.1, 1.1.1, 1.1.1.1, 1.1.1.1/1.1, 1/1.1.1.1, 11)
 
 
 
#6
04.12.2023 05:46:18
Тогда сложнее. Можно искать заголовки столбцов(если они есть) или Итоги, или еще какой уникальный признак столбца, или, как и раньше, спрашивать номер столбца у пользователя
Согласие есть продукт при полном непротивлении сторон
 
 
 
#7
05.12.2023 04:07:46
Sanja, Я вот понять не могу, как перейти от выделенного столбца к поиску значений, в нем находящихся.
Если при вызове
Код
Set ColSearch = Application.InputBox("Выберите столбец для поиска:", Type:=8)
указывать не весь столбец, а допустим с B5 по B10, как получить отсюда координаты в массив

Код
arr = .Range(.Cells(5, 2), .Cells(10, 2)).Value

чтобы дальше с ним работать?

UPD/

Хотя вроде начал понимать логику Вашего решения. Макрос пробегает по листам и из заранее указанного диапазона формирует массив, из которого извлекает необходимые данные.

Если допустить, что макрос не знает заранее по каким столбцам искать, и в каком соседнем столбце нужное для суммирования значение.

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

Насколько сложно поменять логику подсчета? Т.е. не заранее в коде указать столбцы для формирования массива, а спросить какие данные ищем и искать их по листам?  

Изменено: trovial - 05.12.2023 04:35:16
 
 
 
#8
05.12.2023 07:58:28
Если данные на всех листах расположены одинаково, то можно в каком нибудь листе выделить любую ячейку в нужном столбце (в котором ищем данные) и от него плясать (смещение тоже должно быть одинаково во всех листах), а если в каждом листе расположение разное, то или запрашивать для каждого листа у пользователя или сначала вручную пройтись по всем листам, повыделять ячейки в нужных столбцах, где-то в ячейке указать смещение и потом запускать макрос
Согласие есть продукт при полном непротивлении сторон
 
 
 
#9
05.12.2023 08:13:31
Sanja, Данные на всех листах, кроме "000" одинаковой структуры, как и смещение ячейки, которую нужно копировать (и суммировать при количестве более 1 позиции). Данные на листе "000" по структуре будут отличаться. Разве что номер столбца с поиском может совпадать, а смещение может быть рандомным.
Как я вижу реализацию запросов:
Код
Set ColSearch = Application.InputBox("Выберите столбец для поиска:", Type:=8)
Set OffsetCopy = Application.InputBox("Выберите столбец для поиска:", Type:=8)
Set OffsetPaste = Application.InputBox("Выберите столбец для поиска:", Type:=8)
а как применить полученные данные от пользователя?
 
 
 
#10
05.12.2023 08:39:07
Цитата
trovial написал:
Данные на всех листах, кроме "000" одинаковой структуры
Тогда проще. Можно и без запросов обойтись. Напишите нужные данные в свободных ячейках целевого листа (например), и берите их оттуда в код
См.файл (вбить нужные данные в желтые ячейки, выделить серую и нажать на кнопку)
Скрытый текст
Изменено: Sanja - 05.12.2023 08:49:43 (Подправил код и заменил файл)
Согласие есть продукт при полном непротивлении сторон
 
 
 
#11
05.12.2023 08:44:49
Цитата
trovial написал:
Set ColSearch = Application.InputBox("Выберите столбец для поиска:", Type:=8)
Цитата
trovial написал:
а как применить полученные данные от пользователя?
Например так
Код
iClmn = ColSearch.Column 'номер выделенного столбца
Согласие есть продукт при полном непротивлении сторон
 
 
 
#12
05.12.2023 15:17:23
Sanja,
Код
Sub trovial()
Dim iSh As Worksheet
Dim arr()
Dim iDic As Object
Dim ColSearch As Range
Dim I&, iCS&, iOC&, iOP&

Set ColSearch = Application.InputBox("Выберите столбец для поиска:", Type:=8)
Set iOCc = Application.InputBox("Смещение искомой ячейки с данными:")
Set iOPc = Application.InputBox("Смещение для вставки суммы:")

iCSc = ColSearch.Column 'номер столбца искомых данных
'iOCc = OffsetCopy.Value 'столбец смещения данных для копирования
'iOPc = OffsetPaste.Value 'столбец смещения данных для вставки

Set iDic = CreateObject("Scripting.Dictionary")
For Each iSh In ThisWorkbook.Worksheets
  If iSh.Name <> "000" Then
    With iSh
      arr = .Range(.Cells(1, iCSc), .Cells(.Cells(.Rows.Count, iCSc).End(xlUp).Row, iCS + iOCc)).Value
    End With
    For I = LBound(arr, 1) To UBound(arr, 1)
      If iDic.Exists(arr(I, 1)) Then
        iDic(arr(I, 1)) = iDic(arr(I, 1)) + arr(I, 4)
      Else
        iDic.Add arr(I, 1), arr(I, 4)
      End If
    Next
    Erase arr
  End If
Next

Пробую так. Но при запросе ввода смещения, после ввода числа вылетает ошибка. Аргументы параметра Type пробовал 2 и без него, одинаково "runtime error 13 type mismatch"
 
 
 
#13
05.12.2023 18:19:40
Почему Вы так настойчиво пытаетесь использовать InputBox? Чем не устраивает настройка тех-же параметров на обычном листе (можно вообще на отдельном), который гораздо привычнее пользователю?
Если это действительно принципиально, то прочитайте про аргумент Type
и про типы данных, и способы присваивания значений различным типам переменных. Зачем Вы везде Set вставляете?
Согласие есть продукт при полном непротивлении сторон
 
 
 
#14
06.12.2023 03:56:16
Sanja, подход с применением формы ввода данных и/или выбора диапазона выбран по причине возможного использования данного макроса не только мной.
Если углубиться в суть вопроса и откуда пошло желание найти решение моего вопроса через макрос, то получается следующая история:
- есть 2 файла, первый - тот что с номерами листов от 1 до 10, второй - с именем 000.
- перед проверкой лист из второго файла копируется в первый.
- на каждом листе имеется шапка с текстовыми данными.
Отсюда и желание ускорить процесс проверки. Данные в файле №2 считаем правильными, а данные на листах файла №1 остается сверить.
Определять каждый раз в новом файле ячейки для ввода диапазона поиска и смещений для меня не проблема. А человек (далекий от темы макросов, да и в принципе в формулах экселя разбирающийся на уровне сложить/поделить/получить среднее значение) может не понять принципа работы и подготовки листа для правильной работы (да и вообще работы) макроса.
Ну и, к тому же, при успешной отладке данного решения, есть желание сделать данный макрос надстройкой.

Попрошу Вас, по возможности, оценить работоспособность такого решения. Если нет, будем думать...

UPD/
В таком виде ...
Код
Sub trovial()
Dim iSh As Worksheet
Dim arr()
Dim iDic As Object
Dim ColSearch As Range
Dim I&, iCS&, iOC&, iOP&

Set ColSearch = Application.InputBox("Выберите столбец для поиска:", Type:=8)
iOCc = Application.InputBox("Смещение искомой ячейки с данными:", Type:=2)
iOPc = Application.InputBox("Смещение для вставки суммы:", Type:=2)

iCSc = ColSearch.Column 'номер столбца искомых данных

Set iDic = CreateObject("Scripting.Dictionary")
For Each iSh In ThisWorkbook.Worksheets
  If iSh.Name <> "000" Then
    With iSh
      arr = .Range(.Cells(1, iCSc), .Cells(.Cells(.Rows.Count, iCSc).End(xlUp).Row, iCSc + iOCc)).Value
    End With
    For I = LBound(arr, 1) To UBound(arr, 1)
      If iDic.Exists(arr(I, 1)) Then
        iDic(arr(I, 1)) = iDic(arr(I, 1)) + arr(I, 1 + iOCc)
      Else
        iDic.Add arr(I, 1), arr(I, 1 + iOCc)
      End If
    Next
    Erase arr
  End If
Next
... ошибки уже не возникает
Изменено: trovial - 06.12.2023 05:49:00
 
 
 
#15
06.12.2023 09:12:54
Цитата
trovial написал:
Попрошу Вас, по возможности, оценить работоспособность такого решения
Если Вас устраивает и работает без ошибок, то и пользуйтесь)
Согласие есть продукт при полном непротивлении сторон
 
 
 
#16
06.12.2023 15:35:27
Sanja, извините, но можете еще подсказать?
вот здесь
Код
With Worksheets("000")
  arr = .Range("B5:C" & .Cells(.Rows.Count, "B").End(xlUp).Row).Value
на листе 000 переопределяются границы массива?
если так, то получается первый элемент массива можем получить из
Код
Set ColSearch = Application.InputBox("Выберите столбец для поиска:", Type:=8)
iCSc = ColSearch.Column 'номер столбца искомых данных
iCSr = ColSearch.Rows 'номер столбца искомых данных
...
With Worksheets("000")
  arr = .Range(iCSc&iCSr
?
 
 
 
#17
06.12.2023 15:40:38
Код
  arr = .Range(ColSearch.Address(0, 0, xlA1)
 
 
 
#18
06.12.2023 16:26:32
МатросНаЗебре, это первый элемент массива?
первую координату последнего элемента можно получить через номер последней строки из выделенной области в ColSearch, а вторую через через номер столбца  ColSearch (переменная iCSc) с добавлением смещения для вставки данных (переменная iOPc)?
 
 
 
#19
06.12.2023 17:19:11
Цитата
trovial написал:
на листе 000 переопределяются границы массива?
Нет. Что бы не плодить переменные, в массив arr заноситься столбец из листа 000. Старые данные удаляются
Согласие есть продукт при полном непротивлении сторон
 
 
 
#20
07.12.2023 01:34:23
Sanja, то есть можно ограничиться ?
Код
arr = .Range(ColSearch.Address(0, 0, xlA1)).Value
 
 
 
#21
07.12.2023 02:59:14
Неужели Вам самому не интересно попробовать? Впишите эту строку в код и посмотрите, что попадает в массив arr.
Согласие есть продукт при полном непротивлении сторон
 
 
 
#22
07.12.2023 04:01:37
Sanja, я попробовал, ошибки не появляется. А как увидеть, что попадает в массив?

UPD/
после ошибки пошел в дебаг, в
Код
  arr = .Range(ColSearch.Address(0, 0, xlA1)).Value
отображается выбранный диапазон, например B5:B20. А ошибка появляется в
Код
With Worksheets("000")
  arr = .Range(ColSearch.Address(0, 0, xlA1)).Value
  For I = LBound(arr, 1) To UBound(arr, 1)
    If iDic.Exists(arr(I, 1)) Then
--->> arr(I, 2) = iDic(arr(I, 1))
    End If
  Next
  .Range("C5").Resize(UBound(arr, 1)) = Application.Index(arr, 0, 2)
End With

как понять, что он хочет?

subscript out of range, индекс за пределами диапазона...

Изменено: trovial - 07.12.2023 04:35:25
 
 
 
#23
07.12.2023 07:30:36
Цитата
trovial написал:
А как увидеть, что попадает в массив?
Если Вы серьезно намерены заниматься VBA, то обязательно нужно освоить инструменты отладки кода. Точки останова, пошаговое выполнение, просмотр промежуточных значений в окнах Locals/Watch/Immediate Window и т.п.
Цитата
trovial написал:
как понять, что он хочет?
Вы можете приложить весь переработанный код? А то по кускам мало что понятно, а переделывать самому - нет желания. А лучше приложите файл с внедренным кодом
Согласие есть продукт при полном непротивлении сторон
 
 
 
#24
07.12.2023 08:22:54
Цитата
написал:
Если Вы серьезно намерены заниматься VBA
Было время, когда нужно было передать один проект под себя, очень увлекся vba. Потом заглохло. Сейчас по воспоминаниям пытаюсь решить единичную задачу. Но получается, что знаний не достаточно.
Цитата
написал:
Вы можете приложить весь переработанный код
Да, конечно.
 
 
 
#25
07.12.2023 09:21:50
Цитата
trovial написал:
отображается выбранный диапазон, например B5:B20.
При такой конструкции Вы забираете в массив ВЕСЬ столбец B, более миллиона строк. Вам точно ЭТО нужно?
Согласие есть продукт при полном непротивлении сторон
 
 
 
#26
07.12.2023 09:36:43
Sanja, нет, не нужно. в массив должны попасть только заполненные строки.

а вставку на лист 000 делать по размеру выделенного диапазона.  
 
 
 
Страницы: 1
Наверх