Таблицу переформатировать в вид базы данных

[AlexZZZ]

Доброго времени суток! Помогите, пожалуйста, с написанием макроса по переформатированию таблицы из наглядного вида в вид базы данных. Пример таблицы прилагаю. Поскольку данные потом будут использоваться для сводных таблиц, таблицы квартальных итогов и столбцы суммирования учитывать не нужно.
Хотя бы подскажите, в каком направлении двигаться или подкиньте пример похожего макроса. Наверняка, кто-то с похожими задачами уже сталкивался. А многим это сильно пригодилось бы и в будущем.
Спасибо!

[packer]

... Хотя бы подскажите, в каком направлении двигаться или подкиньте пример похожего макроса. Наверняка, кто-то с похожими задачами уже сталкивался. А многим это сильно пригодилось бы и в будущем.
Спасибо!

У Вас на 1-й взгляд данные отлично структурированы - каждая таблица из 14 строчек эксельных. Напишите сначала обработку этих 14-ти строк:

Код: Выделить всё

'Для каждой таблицы типа "данные за [B]этот[/B] месяц"
'цикл по каждому препарату i
        'цикл по каждому учреждению j
      ...
      AddingItemDrug=Cells(начальнаястрока[B]этой[/B]таблицы,1).Offset(i,0)    
      AddingItemPrice=Cells(начальнаястрокаэтойтаблицы,1).Offset(i,1)            
      AddingItemSales=Cells(начальнаястрокаэтойтаблицы,1).Offset(i,j)
      'И теперь полученные данные (строку данных по сути) скидываете куда-то - хоть на отдельный лист книги Экселя, хоть сразу в таблицу БД (ч-з ADO или еще как-то), кот-ю Вы уже с помощью какой-либо СУБД раньше создали. 

Ну и так прогоните по всем таблицам этого листа, по всем листам книги (если есть) и тд и тп.
По-моему, вполне приемлимый вар-т, только подумайте насчет оптимизации циклов - чтобы излишних сложностей порядка N^2 не возникло - на десятках тысяч строк это может нехорошо на времени работы макроса сказаться.
ЗЫ Офф: а на будущее сразу вводите данные в том виде, в кот-м у Вас на листе "Нужно" они.

[AlexZZZ]

Спасибо, идея понятна! Буду пробовать.

ЗЫ Офф: а на будущее сразу вводите данные в том виде, в кот-м у Вас на листе "Нужно" они.

Данные будут вводиться теперь, конечно, по новому. Задача поставлена данные за прошлые года в новый вид конвертировать.

[Dim_ok]

Код: Выделить всё

Option Explicit
Option Base 1

Sub Base()
Dim i As Long
Dim j As Long
Dim jj As Long
Dim FndMnth As String
Dim Sets As Object
Dim Need As Object
Application.ScreenUpdating = False
    Set Sets = Worksheets("Дано")
    Set Need = Worksheets("Нужно")
    ReDim Mounth(1 To 12)
    Mounth = Array("январь", "февраль", "март", "апрель", "май", _
    "июнь", "июль", "август", "сентябрь", "октябрь", "ноябрь", "декабрь")
    With Sets
        For i = 1 To 12
            FndMnth = .Cells.Find(What:=Mounth(i)).Address
            j = 3
            Do While .Cells(.Range(FndMnth).Row + 2, j) <> 0
                For jj = .Range(FndMnth).Row + 3 To .Range(.Range(FndMnth).Offset(3, -1).Address).End(xlDown).Row
                    Need.Cells(Need.Range("A65000").End(xlUp).Row + 1, 1) = .Range(FndMnth).Offset(0, 1)
                    Need.Cells(Need.Range("A65000").End(xlUp).Row, 2) = .Range(FndMnth)
                    Need.Cells(Need.Range("A65000").End(xlUp).Row, 3) = .Range(FndMnth).Offset(0, 3)
                    Need.Cells(Need.Range("A65000").End(xlUp).Row, 4) = .Cells(jj, 1)
                    Need.Cells(Need.Range("A65000").End(xlUp).Row, 5) = .Cells(jj, 2)
                    Need.Cells(Need.Range("A65000").End(xlUp).Row, 6) = .Cells(.Range(FndMnth).Row + 2, j)
                    If .Cells(jj, j) = "" Then
                        Need.Cells(Need.Range("A65000").End(xlUp).Row, 7) = 0
                    Else
                        Need.Cells(Need.Range("A65000").End(xlUp).Row, 7) = .Cells(jj, j)
                    End If
                Next
                j = j + 1
            Loop
        Next
    End With
Application.ScreenUpdating = True
End Sub

[AlexZZZ]

Огромное Вам спасибо!
Ваш код работает безупречно. После маленькой модификации сработал и на немного отличающейся таблице.
Есть чему поучиться!