Разнесение данных из одной общей таблицы в несколько других

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

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

Разнесение данных из одной общей таблицы в несколько других (Формулы)

Monya

Дата: Четверг, 12.12.2013, 17:55 | Сообщение № 1

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

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

Сообщений: 2

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

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

Excel 2007

Добрый день, господа.

Прошу помочь организовать разнесение данных из одной общей таблицы в несколько других.

В верхней таблице ежедневно вставляются данные статистики за прошедший день.
Количество людей в статистике за прошедший день может меняться. Могут быть не все из тех для кого есть таблицы ниже.

В данный момент разнесение данных в таблицы по сотрудникам производится копированием вручную.
Как сделать чтобы программа для каждого из людей в первой таблице искала по ФИО его таблицу и вставила данные в строку с датой, которая указана в ячейке B1. Например по нажатии на кнопку.

Заранее благодарен.
Дмитрий

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

Ответить

Hugo

Дата: Четверг, 12.12.2013, 18:26 | Сообщение № 2

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3735

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

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

365

[vba]

Код

Option Explicit

Sub tt()
            Dim a(), i&, t$, x&

            Application.ScreenUpdating = False

            With CreateObject("Scripting.Dictionary"): .comparemode = 1
                a = [a1].CurrentRegion.Value
                For i = 2 To UBound(a): .Item(a(1, 2) & "|" & a(i, 3)) = i: Next

                For i = UBound(a) To Cells(Rows.Count, "B").End(xlUp)(2).Row
                    t = Cells(i, 2) & "|" & Cells(i, 3)
                    If .exists(t) Then
                        For x = 4 To UBound(a, 2): Cells(i, x) = a(.Item(t), x): Next
                    End If
                Next
            End With
            Application.ScreenUpdating = True

End Sub

[/vba]

Да, между верхней таблицей и первой нижней обязательно должна быть хотя бы одна полностью пустая строка!
И данные верхней таблицы должны быть как в примере одним сплошным блоком.
Иначе нужно иначе определять диапазон для массива a(), например так:
[vba]

Код

a = [a1:x24].Value

[/vba]
Тогда весь код будет чуть другим:
[vba]

Код

Option Explicit

Sub tt()
      Dim a(), i&, t$, x&

      Application.ScreenUpdating = False

      With CreateObject("Scripting.Dictionary"): .comparemode = 1
          a = [a1:x24].Value
          For i = 2 To UBound(a)
          If Len(Trim(a(i, 3))) Then .Item(a(1, 2) & "|" & a(i, 3)) = i
          Next

          For i = UBound(a) To Cells(Rows.Count, "B").End(xlUp)(2).Row
              t = Cells(i, 2) & "|" & Cells(i, 3)
              If .exists(t) Then
                  For x = 4 To UBound(a, 2): Cells(i, x) = a(.Item(t), x): Next
              End If
          Next
      End With
      Application.ScreenUpdating = True

End Sub

[/vba]

[vba]

Код

a = [a1:x24].Value

[/vba]
Тогда весь код будет чуть другим:
[vba]

Код

[/vba]Hugo

webmoney: E265281470651 Z422237915069
USDT TRC20: TN8XeEF17o5KPBD9pNwYzNyruycuAc2mVD

Ответить

Сообщение[vba]

Код

a = [a1:x24].Value

[/vba]
Тогда весь код будет чуть другим:
[vba]

Код

[/vba]

Автор - Hugo
Дата добавления - 12.12.2013 в 18:26

Monya

Дата: Четверг, 12.12.2013, 20:36 | Сообщение № 3

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

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

Сообщений: 2

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

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

Excel 2007

Большое спасибо. Это то, что и было нужно.

Ответить

Разнесение данных из одной общей таблицы в несколько других (Формулы)

Страница 1 из 1
1