Попытка скопировать таблицы с одного листа на другой, но в другом формате. Excel VBA - PullRequest
0 голосов
/ 24 января 2019

Я пытаюсь объединить 2 разных таблицы, которые существуют на одном листе ("DEMO FOOD + OIL") , в новый лист ("Данные") в другом формате.

1-ая таблица начинается с TOTAL FOOD + BEVERAGE , и рядом с ней располагаются меры (VALUE, VOLUME).Второе - это следующее, которое начинается с OIL .

Прямо под этими таблицами находится требуемая объединенная таблица.Итак, что делает мой код на данный момент.Начинается с ячейки "B6", проходит вниз, пока не достигнет пустой ячейки.Выбирает диапазон («B6: B10»).Копирует диапазон и вставляет его в «Лист данных».На исходном листе выбирается период «2015 MAT P13».Перебирает данные под ним, пока они не станут пустыми, и вставляет этот диапазон в «Данные» в столбец «D». Затем он перемещается на 1 столбец вправо.

Что бы я хотел, чтобы программа сделала, это скопироваласледующие данные в листе «Данные»: 1. для «ВСЕГО ПИТАНИЯ + НАПИТКИ»: скопируйте демографические данные (возраст T.HOUSEWIFE и т. д.) в ячейку «С2»

2.данные (ниже «ЗНАЧЕНИЕ») дляпериод 2015 в ячейку "D2"

3.период "2015 MAT P13" в ячейке "B2"

4. категория черных (TOTAL FOOD + BEVERAGE) в ячейке "C2"

поместите «VALUE» в качестве заголовка в ячейку «D2». переместитесь вправо до следующей меры, то есть «VOLUME», и повторите тот же процесс.примечание: «VALUE» и «VOLUME» - это объединенные ячейки, поэтому Excel считывает VALUE, которая существует в ячейке C4.

, поэтому мне нужно:

, когда оно проходит по периодамМне нужно, чтобы программа проверила следующее:

  1. диапазон начинается с "2015 MAT P13" в ячейке "C5".

, если ячейка над ней является строкойи не пустой, выполните весь процесс, упомянутый ранее ". В исходном листе выбирается период" 2015 MAT P13 "" и т. д.

перейти к следующему периоду "2016 MAT P13",Выполните ту же процедуру, что и выше, проверяя, есть ли над ней строка.Если нет, посмотрите налево, пока не найдете его.

Так что после того, как мы закончили с этими 2 периодами, мне нужно, чтобы программа проверила, совпадает ли следующая мера справа "VOLUME" спредыдущий "ЗНАЧЕНИЕ", он не должен ссылаться конкретно на эти меры.Там могут быть и другие меры в наших таблицах тоже.Если показатель не совпадает, мы следуем той же процедуре вставки диапазонов, но на этот раз мы делаем это для «VOLUME» и вставляем данные ниже данных «VALUE».

Исходная база данных

желаемая таблица

Я надеюсь, что это имеет смысл, и я буду признателен за любую помощь: Вот код, который я уже реализовал:

 Sub test()

Dim datash As Worksheet
Dim datarng As Range
Dim tsh As Worksheet
Dim startrng As Range
Dim startrng2 As Range
Dim endrng As Range
Dim endrng2 As Range
Dim copyrng As Range
Dim r2 As Range
Dim locatefirstcategory As Range
Dim L As Long
Dim startrng3 As Range
Dim cell As Variant




Set datash = ActiveSheet

' copying demographics range

Set datarng = datash.Cells(6, 2)
Set startrng = datarng


Do Until datarng = ""

    Set datarng = datarng.Offset(1, 0)

Loop

Set endrng = datarng(0, 1)

    datash.Range(datash.Cells(startrng.Row, datarng.Column), datash.Cells(endrng.Row, datarng.Column)).Select

    Sheets("Data").Activate

    datash.Range(datash.Cells(startrng.Row, datarng.Column), datash.Cells(endrng.Row, datarng.Column)).Copy Destination:=Sheets("Data").Range("C2")


' copying the measure values

Sheets("DEMO FOOD+OIL").Activate

Dim rng2 As Range


    Set rng2 = datash.Cells(5, 3)
    Set startrng2 = rng2


Dim measurestr As String
Dim periodstr As String


    measurestr = rng2(0, 1).Value
    periodstr = rng2.Value

Dim rng3 As Range
Set rng3 = Sheets("Data").Cells(2, 4)



Do Until rng2 = ""

    ' checking is there's a measure above the period.
    ' if not, look for the measure above the 1st period

Sheets("DEMO FOOD+OIL").Activate


    ' moving 1 column to the right, selecting it and copying the measure data

        datash.Range(datash.Cells(startrng.Row, rng2.Column), datash.Cells(endrng.Row, rng2.Column)).Select

        Sheets("Data").Activate

        datash.Range(datash.Cells(startrng.Row, rng2.Column), datash.Cells(endrng.Row, rng2.Column)).Copy Destination:=Sheets("Data").Range("D2")

    Set rng2 = rng2.Offset(0, 1)

    Sheets("DEMO FOOD+OIL").Activate

Loop

Stop


'copying the period

Dim datarng2 As Range


Sheets("Data").Activate

Set datarng2 = ThisWorkbook.Worksheets("Data").Cells(2, 2)

Do Until datarng2.Offset(0, 1) = ""

    datarng2.Value = periodstr

Set datarng2 = datarng2.Offset(1, 0)

Loop

Stop


Sheets("DEMO FOOD+OIL").Activate

'selecting the category in order to paste it to the Data sheet
'Dim rng3 As Range
Dim categorystr As String


    Set rng3 = datash.Cells(4, 2)
    'Set startrng3 = rng3

    categorystr = rng3.Value



' pasting the black Category to the datasheet next to the period

Sheets("Data").Activate

Dim datarng3 As Range

Set datarng3 = ThisWorkbook.Worksheets("Data").Cells(2, 1)


Do Until datarng3.Offset(0, 1) = ""

    datarng3.Value = categorystr

Set datarng3 = datarng3.Offset(1, 0)

Loop

Stop

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...