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

Вход

Регистрация

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

 

= Мир MS Excel/Сопоставление списков на двух листах и вывод результата - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сопоставление списков на двух листах и вывод результата (Макросы/Sub)
Сопоставление списков на двух листах и вывод результата
lenochka Дата: Четверг, 28.01.2021, 22:15 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

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

Автор - lenochka
Дата добавления - 28.01.2021 в 22:15
Kuzmich Дата: Пятница, 29.01.2021, 00:02 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 575
Репутация: 113 ±
Замечаний: 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]
 
Ответить
Сообщение
Цитата
помогите с макросом

[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]

Автор - Kuzmich
Дата добавления - 29.01.2021 в 00:02
lenochka Дата: Пятница, 29.01.2021, 10:09 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

'запускать при активном листе Результат
Sub Resultat()
K Kuzmich, большое, при большое вам спасибо человеческое спасибо!
 
Ответить
Сообщение
'запускать при активном листе Результат
Sub Resultat()
K Kuzmich, большое, при большое вам спасибо человеческое спасибо!

Автор - lenochka
Дата добавления - 29.01.2021 в 10:09
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сопоставление списков на двух листах и вывод результата (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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