Сопоставление списков на двух листах и вывод результата

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Сопоставление списков на двух листах и вывод результата (Макросы/Sub)

lenochka

Дата: Четверг, 28.01.2021, 22:15 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

Репутация: 0 ±

Замечаний: 0% ±

Ребята, прошу уделить мне внимание. У меня есть файл в котором есть три листа, "Купил" ; "Продал" ; "Результат" В первых двух листах по два столбца (Позиция и Количество), причем строк может быть каждый раз разное количество. И мне надо сопоставить данные по каждой уникальной позиции, сколько купил, сколько продал и результат, как разница между купил и продал. Часто может быть так что продал то что не купил и в результате будет отрицательное число. Я с помощью копирования наименований позиций с двух листов "Купил" и "Продал" и вставкой на третий лист "Результат" удалила дубликаты. А затем использовала суммесли для сбора данных. Ребята прошу вас если несложно помогите с макросом, я это делаю почти ежедневно и уже упипикалась)) То есть в идеале я просто вставляю данные в первые два листа, а в третьем макросом идет подсчет. Пример приложила.

К сообщению приложен файл: -_.xlsx (10.3 Kb)

Ответить

Kuzmich

Дата: Пятница, 29.01.2021, 00:02 | Сообщение № 2

Группа: Проверенные

Ранг: Ветеран

Сообщений: 713

Репутация: 157 ±

Замечаний: 0% ±

Excel 2003

Цитата

помогите с макросом

[vba]

Код

'запускать при активном листе Результат
Sub Resultat()
Dim dic As Object, i&
Set dic = CreateObject("Scripting.Dictionary")
Dim Wsh As Worksheet
Dim iLastRow As Long
Dim iLR As Long
Dim Result As Worksheet
Dim FoundPosition As Range
  Set Result = ThisWorkbook.Worksheets("Результат")
  iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
  Range("B5:E" & iLastRow).ClearContents        'очищаем диапазон данных на листе Результат
For Each Wsh In Worksheets                     'цикл по листам, кроме Результат
   If Wsh.Name <> "Результат" Then
     Wsh.Activate
     iLR = Cells(Rows.Count, "B").End(xlUp).Row
    For i = 5 To iLR
      dic.Item(CStr(Cells(i, "B"))) = 0         'заполняем словарь
    Next i
   End If
Next
   Result.Activate
   Range("B5").Resize(dic.Count) = Application.Transpose(dic.keys)
     iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
   For Each Wsh In Worksheets                     'цикл по листам, кроме Результат
    If Wsh.Name <> "Результат" Then
      With Wsh
        For i = 5 To iLastRow
          Cells(i, "E") = "=C" & i & "- D" & i    'разность C-D
          Set FoundPosition = .Columns("B").Find(Cells(i, "B"), , xlValues, xlWhole)
          If Not FoundPosition Is Nothing Then
            If Wsh.Name = "Купил" Then Cells(i, "C") = Cells(i, "C") + FoundPosition.Offset(, 1)
            If Wsh.Name = "Продал" Then Cells(i, "D") = Cells(i, "D") + FoundPosition.Offset(, 1)
          End If
        Next
      End With
    End If
Next
End Sub

[/vba]