Страницы: 1
RSS
Перенос данных из одного столбца в другой
 
Ребята помогите. Нужно чтобы данные из одной таблицы попадали в другую в соответствии со столбцом первой таблицы. Коряво объяснил очень, в фаиле прикрепленном все более понятно. Как это можно сделал? Суть в том чтобы люди заполняли таблицу 1 и данные появлялись (распределялись) параллельно на таблицу 2. Заранее большое спасибо.
 
Цитата
dodge написал:
Нужно чтобы данные из одной таблицы попадали в другую
нужно когда?
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Когда заполняется таблица 1, сразу же появлялись в таблицу 2. Ну т.е. сразу.
 
dodge, для F3 формула массива, растягивается вниз и вправо
Код
=ЕСЛИОШИБКА(ИНДЕКС($B:$B;НАИМЕНЬШИЙ(ЕСЛИ($A$1:$A9999=F$2;СТРОКА($1:$9999));СТРОКА($A1)));"")
Изменено: Казанский - 06.01.2019 12:14:11
 
Привет!
Во вложении.
Сравнение прайсов, таблиц - без настроек
 
Казанский, формула не работает(
 
dodge, а Вы обратили внимание на фразу ФОРМУЛА МАССИВА?
 
Огромное всем спасибо! Методом тыка разобрался в представленной формуле.
 
Цитата
Inexsu написал:
           Столб_Назн_обНулить _
                   Значение_подБить( _
                   Диап_Назн_ПереОпределить( _
                   Столбец_Добавить( _
                   Столбец_Найти( _
                   Диап_Назн_Заголовки))))
Вы наверно профессиональный программист? На каждое действие своя процедура, все структурировано...
Правда, и быстродействие соответствующее - распределение 22 ячеек занимает секунду (Офис 2007, Core2Duo 1.6ГГц).
Оставлю здесь код, не лучший в плане быстродействия, но все же на полтора-два порядка быстрее.
В словарь по ключу Название кладется массив: номер столбца и последней занятой строки результирующего массива.
Код
Sub bb()
Dim v(), i&, di As Object, a()
  Set di = CreateObject("scripting.dictionary")
  v = Range("A2", Cells(Rows.Count, "B").End(xlUp)).Value
  ReDim w(1 To UBound(v), 1 To 1)
  For i = 1 To UBound(v)
    If di.exists(v(i, 1)) Then
      a = di(v(i, 1))
    Else
      a = Array(di.Count + 1, 1)
      If UBound(w, 2) < a(0) Then ReDim Preserve w(1 To UBound(v), 1 To a(0))
      w(1, a(0)) = v(i, 1)
    End If
    a(1) = a(1) + 1
    w(a(1), a(0)) = v(i, 2)
    di(v(i, 1)) = a
  Next
  Range("D1").Resize(UBound(w), UBound(w, 2)).Value = w
End Sub
Вариант, в котором номер столбца занимает младшие 3 разряда числа, хранящегося в словаре, а номер строки - разряды начиная с 4-го. Целочисленные операции разборки-сборки числа гораздо быстрее операций с массивом.
Код
Sub bb1()
Const M& = 1000
Dim v(), i&, di As Object, r&, c&
  Set di = CreateObject("scripting.dictionary")
  v = Range("A2", Cells(Rows.Count, "B").End(xlUp)).Value
  ReDim w(1 To UBound(v), 1 To 1)
  For i = 1 To UBound(v)
    If di.exists(v(i, 1)) Then
      r = di(v(i, 1))
      c = r Mod M
      r = r \ M + 1
    Else
      c = di.Count + 1
      r = 2
      If UBound(w, 2) < c Then ReDim Preserve w(1 To UBound(v), 1 To c)
      w(1, c) = v(i, 1)
    End If
    w(r, c) = v(i, 2)
    di(v(i, 1)) = r * M + c
  Next
  Range("D1").Resize(UBound(w), UBound(w, 2)).Value = w
End Sub
Изменено: Казанский - 06.01.2019 22:45:06
 
Привет, Казанский!
Цитата
Казанский написал:
На каждое действие своя процедура, все структурировано
Рефакторинг и ремонтопригодность кода.

Конечно Ваш код стремителен!! Но сложен :-(. Ещё недавно я тоже так хотел кодить :-). Мой код тоже ждёт улучшений.
Вот выкатит ТС уточнения, через пару недель и посмотрим чей код проще подстроить под новые требования :-)
dodge, сильно Вам нужна скорость в этой задаче?
Сравнение прайсов, таблиц - без настроек
 
Код
Sub ReTab()
  Dim ar, dc, v, i&:  Set dc = CreateObject("Scripting.Dictionary")
  ar = Range("A2", Cells(Rows.Count, "B").End(xlUp)).Value
  For i = 1 To UBound(ar)
    dc(ar(i, 1)) = dc(ar(i, 1)) & Chr(9) & ar(i, 2)
  Next
  ar = dc.keys
  For i = 0 To UBound(ar)
    v = Split(ar(i) & dc(ar(i)), Chr(9))
    Cells(2, 6 + i).Resize(1 + UBound(v), 1).Value = WorksheetFunction.Transpose(v)
  Next
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, работает... пока числа целые :D
 
Леша,
а с какими числами проблема? добавляются себе в строку по-одному, даже если в В не числа будут
на исходніх получается 4 колонки данных, в последней:
и т.д.   вниз различные сотрудники
Различные цифры, расходы денег.
Изменено: Ігор Гончаренко - 07.01.2019 02:07:32
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
dodge написал:
Методом тыка разобрался в представленной формуле.
А что тут тыкать то? Казанский написал формулу. Вставляешь в ячейку F3 и в выделенной позиции нажимаешь cntrl+shift+enter (это и называется формула массива).
 
Цитата
Ігор Гончаренко написал:
а с какими числами проблема?
С дробными - по крайней мере, в русской локали. Числа с 1-2 знаками после запятой например 12,3   12,34 превращаются в текст, и столбец уже не просуммируешь. Чисел с бОльшим количеством знаков после запятой вроде не должно быть, т.к. это денежные суммы, но могли например скопировать и вставить результаты каких-то расчетов. И 12,345 превращаются в 12345, 12,3456 превращаются в 123456 и т.д.
Ну это так, мелкие придирки :)
 
довавить Replace в 5-ю строку:
Код
dc(ar(i, 1)) = dc(ar(i, 1)) & Chr(9) & Replace("" & ar(i, 2), ",",".")
но это так - мелкие отписки))
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
Страницы: 1
Наверх