Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
копирование на соседний лист данных по совпадению кода, часть ячеек объединением значений,часть суммированием
 
#1
20.08.2024 18:28:17
Прошу помощи.
Необходимо заполнить отчет - данные придется вносить или вручную или копированием, т.к. стоит защита листа на все остальное (выделение ячейки цветом, внесение формул и т.п.). Даже если удастся снять - отчет не примут (
Промежуточный вариант -  заполнить по образцу обычную таблицу и просто скопировать-вставить в отчет.
Приобретено/получено - порядка 3тыс позиций (6 тыс шт) у разных поставщиков по разным ценам.
Отчет - куда в помещении расставили  приобретенные объекты с расшифровкой у кого и по какой цене купили (получили).

Делаю в несколько заходов, поэтому как отделить данные отработанные  таблице результат вчера от завтра?

Подскажите  в какую сторону лучше смотреть VBA или PQ, но тогда как перемещать результат?
Формулами: суммеслимн, сумм произв для количества и сумм, но для наименования как их все собрать в одну ячейку при совпадении кода?

P.S.Так как чувствую что опять что-то приобретут и попросят дополнить - какой лучше разделительный знак между названиями объектов ставить?
Изменено: JMerlin - 20.08.2024 18:31:17
 
 
 
#2
20.08.2024 18:47:44
Если нужно заносить в существующий файл - то VBA, и вроде решаемо.
Но в деталях ждите того кто точно такую работу делал, но уже разгадал эти ребусы - куда, почему что именно...
В PQ можно сформировать таблицу для ручного копипаста в эту форму.
Изменено: Hugo - 20.08.2024 18:52:48
 
 
 
#3
20.08.2024 19:10:51
Результат PQ - умная таблица. Как этот момент можно обойти? Копировать только значения?
Изменено: JMerlin - 20.08.2024 19:30:19
 
 
 
#4
20.08.2024 19:31:41
Здравствуйте,
Вопрос: как быть если на один код приходится несколько наименований? Например: попробуйте на листе "результат" сформировать ячейку "наименование объекта" для кода: х.123.35.
Если не ошибаюсь, то в ячейку можно записать конечное число символов и, в данном случае мы его превысим ...
Изменено: Григорий Калюга - 20.08.2024 19:33:24
 
 
 
#5
20.08.2024 19:50:56
предупреждение вывести - сокращать наименование пока не поместимся - откинуть все скобки и числа- но реальней просто предупреждение с указанием кода, который не помещается,  а потом вручную править наименование - и снова запускать, Пока не поместится.
 
 
 
#6
20.08.2024 20:28:36
Цитата
Григорий Калюга написал:
Например: попробуйте на листе "результат" сформировать ячейку "наименование объекта" для кода: х.123.35.
- всего 6049 символов, через запятую без повторов. Ещё более 20к места есть.
Но конечно это не дело, не практично. Даже всё не увидеть в ячейке...
Хотя не, через запятую увидеть, через символ(10) не увидеть ((
Изменено: Hugo - 20.08.2024 20:34:03
 
 
 
#7
20.08.2024 20:57:27
Цитата
JMerlin написал:
предупреждение вывести
... ну, тогда все просто:
в цикле Do ... Loop идем по колоночке код и собираем в массив наши сборные названия, ну а в пристяжку к ним и все остальные данные. Это как вариант ...
 
 
 
#8
20.08.2024 20:59:59
Доброго времени суток!
Цитата
Hugo написал:
всё не увидеть в ячейке...
не приходилось работать со столь длинными текстами в одной ячейке. А их то, хоть просмотреть получится?
 
 
 
#9
20.08.2024 21:10:50
В следующую ячейку вниз опускаться не вариант, Остается вручную сокращать названия  вплоть до нечитаемых аббревиатур.
Изменено: JMerlin - 21.08.2024 14:10:47
 
 
 
#10
20.08.2024 21:10:52
Цитата
Григорий Калюга написал:
А их то, хоть просмотреть получится?
- вот, все как один ))
 
 
 
#11
20.08.2024 22:47:23
Получилось так, не удалось удалить дубликаты в наименовании и контрагенте.
 
 
 
#12
20.08.2024 23:00:36
Ещё и сколько штук нужно подсчитать, если смотреть как в образце... Может UDF? ))
 
 
 
#13
20.08.2024 23:30:57
UDF- все грустно (, вообще. Если бы похожее нашла, образец хотя бы был...
 
 
 
#14
20.08.2024 23:35:56
JMerlin, вот чуть подкрутил что было ранее написано, можно чуть код почистить если будете применять - см. жёлтое
Упаковал в архив ибо так чуть не лезет
Изменено: Hugo - 20.08.2024 23:36:53
 
 
 
#15
20.08.2024 23:59:21
Буду, Спасибо!

Получилось контрагента вынуть!!!!
 
 
 
#16
21.08.2024 00:07:25
Цитата
JMerlin написал:
Получилось контрагента вынуть!!!!
- если делать с UDF раз уж начали - то версией VLOOKUPCOUPLE() из копилки форума.
В файле выше я делал только задачу с этими штуками в скобках
"Крепление настенное для телевизора (5087,52) (5 шт.)
Телевизор LED Xiaomi Mi TV 4S 50 (113336,2) (4 шт.)
Телевизор LED Xiaomi Mi TV 4S 50 (121986,79) (1 шт.)"
 
 
 
#17
21.08.2024 15:41:32
Спасибо за наводку на копилку. Нашла фунцию сцепитьесли по критериям.
Получилось так. Нашла  и приспособила вроде код VBA - копирование строк (копирование авторство начального кода
Kuzmich), но у меня не работает, очищать-очищает, а копировать -нет,  
Код
'запуск макроса с активного листа Лист2
Sub iPerenos()
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
Dim FoundCell As Range
Dim FoundCell2 As String
Dim FoundCell3 As String
Dim FoundCell4 As String
Dim FoundCell5 As String
Dim FoundCell6 As String
Dim FoundCell7 As String
Dim FAdr As String
Dim KDB As Worksheet

FoundCell2 = "сами"
FoundCell3 = "получили"
FoundCell4 = ""
FoundCell5 = "(5)"
FoundCell6 = "(880)"
FoundCell7 = "Иной"

  Set KDB = ThisWorkbook.Worksheets("результат")
   KDB.Range("c7:z4000").ClearContents   'очистить диапазон на листе "Результат"
  With Worksheets("Лист2")
   iLR = Cells(Rows.Count, "A").End(xlUp).Row
   iLastRow = 8   'первая строка для заполнения на листе "Как должно быть"
  For i = 2 To iLR
    Set FoundCell = .Columns(1).Find(Cells(i, "A"), , xlValues, xlWhole)
     If Not FoundCell Is Nothing Then
      FAdr = FoundCell.Address
      Do
      If Cells(i, "B").Value = FoundCell2 Then
      .Cells(FoundCell.Row, "A").Copy KDB.Cells(iLastRow, "C")
       .Cells(FoundCell.Row, "D").Copy KDB.Cells(iLastRow, "E")
       .Cells(FoundCell.Row, "G").Copy KDB.Cells(iLastRow, "H")
       .Cells(FoundCell.Row, "E").Copy KDB.Cells(iLastRow, "I")
       .Cells(FoundCell.Row, "F").Copy KDB.Cells(iLastRow, "J")
       .Cells(FoundCell.Row, "G").Copy KDB.Cells(iLastRow, "K")
       .Cells(FoundCell.Row, "H").Copy KDB.Cells(iLastRow, "M")
       .Cells(FoundCell.Row, "I").Copy KDB.Cells(iLastRow, "N")
       .Cells(FoundCell.Row, "J").Copy KDB.Cells(iLastRow, "W")
      Else
       .Cells(FoundCell.Row, "A").Copy KDB.Cells(iLastRow, "C")
       .Cells(FoundCell.Row, "D").Copy KDB.Cells(iLastRow, "E")
       .Cells(FoundCell.Row, "G").Copy KDB.Cells(iLastRow, "O")
       .Cells(FoundCell.Row, "E").Copy KDB.Cells(iLastRow, "P")
       .Cells(FoundCell.Row, "F").Copy KDB.Cells(iLastRow, "Q")
       .Cells(FoundCell.Row, "G").Copy KDB.Cells(iLastRow, "R")
       .Cells(FoundCell.Row, "H").Copy KDB.Cells(iLastRow, "T")
       .Cells(FoundCell.Row, "I").Copy KDB.Cells(iLastRow, "U")
       .Cells(FoundCell.Row, "J").Copy KDB.Cells(iLastRow, "W")
      End If
       iLastRow = KDB.Cells(KDB.Rows.Count, "A").End(xlUp).Row + 1
       Set FoundCell = .Columns(1).FindNext(FoundCell)
      Loop While FoundCell.Address <> FAdr
     End If
  Next
 End With
End Sub
И совершенно  не понятно,, как разбить при переносе сумму по источникам (
И кажется не в одну строку с одинаковы кодом попадут значения (
Изменено: JMerlin - 21.08.2024 15:47:21
 
 
 
#18
21.08.2024 16:00:33
Чем решение с UDF не подходит? Суммы суммирует, дубли убирает...
Для других полей чуть другую можно применить.
 
 
 
#19
21.08.2024 16:18:15
UDF удалось вывести - наименование-документы-количество-суммы,
Наверное туплю,
Какой формулой определить попадание  столбец  в зависимости от источника?
.
Как сделать чтобы  объекты по одинаковым кодам  попадали в одну строку?
Например, л.01.1.1  - часть получили, часть сами, и попадает в соседние строки, а должно  одну строку (первым получили, вторым сами)  
Изменено: JMerlin - 21.08.2024 16:21:32
 
 
 
#20
21.08.2024 16:28:44
Цитата
JMerlin написал:
часть получили, часть сами
- если критерий не только код, но и "сами" - то или сделать такой ключ в источнике, или была версия для поиска по двум полям.
В данном случае проще сделать допстолбец.
Изменено: Hugo - 21.08.2024 16:35:04
 
 
 
#21
21.08.2024 21:55:17
И все таки код копирования как поправить на более правильный?
Код
Sub копия()

Worksheets("копия").Range("A3:AA3000").Clear
Worksheets("Лист2").Range("D2:y3000").Copy
Worksheets("копия").Range("D3:y3001").PasteSpecial Paste:=xlPasteValues
Worksheets("Лист2").Range("A2:A3000").Copy
Worksheets("копия").Range("C3:C3001").PasteSpecial Paste:=xlPasteValues
End Sub
 
 
 
#22
21.08.2024 22:21:20
JMerlin,  копировать можно в первую ячейку:
Код
Sub копия2()
Dim lr As Long, lcol As Long

Application.Calculation = xlCalculationManual

With Worksheets("копия")
lr = .Cells(.Rows.Count, 3).End(xlUp).Row
lcol = .Cells(2, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(3, 1), .Cells(lr, lcol)).Clear
End With

With Worksheets("Лист2")
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("D2:y" & lr).Copy
Worksheets("копия").Range("D3").PasteSpecial Paste:=xlPasteValues
.Range("A2:A" & lr).Copy
Worksheets("копия").Range("C3").PasteSpecial Paste:=xlPasteValues
End With

Application.Calculation = xlCalculationAutomatic
End Sub
 
 
 
#23
21.08.2024 23:52:22
Спасибо! Буду пробовать. Отпишусь.  
 
 
 
#24
18.07.2025 15:22:50
Спасибо,  Hugo !
Все получилось.
P.S. Да я знаю поздно.
 
 
 
Страницы: 1
Читают тему
Наверх