Question

我正在尝试将一个表（“ DEMO FOOD + OIL”）中存在的2个不同表合并到新的表（“数据”）下不同的格式。

第一个表是一个以总食品+饮料开头的表，紧随其后的是度量值（VALUE，VOLUME）。下面的第二个以 OIL 开头。

这些表的正下方是所需的联接表。所以，我的代码目前正在做什么。从单元格“ B6”开始，向下循环直至到达空单元格。选择范围（“ B6：B10”）。复制范围并将其粘贴到“数据”表中。在原始工作表中，它选择期间“ 2015 MAT P13”。循环遍历其下的数据，直到为空，然后将该范围粘贴到“ D”列的“数据”中然后将其向右移1列。

我想要程序执行的操作是将以下数据复制到“数据”表中： 1.对于“总食品+饮料”：将受众特征（家庭主妇年龄等）复制到“ C2”单元格中

2015年期间进入单元格“ D2”的2.data（“ VALUE”以下）

3。单元格“ B2”中的“ 2015 MAT P13”

4。“ C2”单元格中的黑色类别（总食品+饮料）

在单元格“ D2”中将“ VALUE”作为标题
向右移动直到下一个小节“ VOLUME”，然后重复相同的过程。注意：“ VALUE”和“ VOLUME”是合并的单元格，因此excel读取单元格C4中存在的VALUE。

因此，我需要的是：

当它循环遍历期间时，我需要程序检查以下内容：

范围从“ C5”单元格中的“ 2015 MAT P13”开始。

如果上方的单元格是字符串而不是空，请执行前面提到的整个过程“在原始工作表中，它选择句点“ 2015 MAT P13”” 等。

移至下一个期间“ 2016 MAT P13”。执行与上述相同的过程，检查其上方是否有字符串。如果没有，请向左看直到找到它。

因此，在完成这两个期间之后，我需要程序检查下一个测量值“ VOLUME”是否与上一个“ VALUE”相同，它不必专门参考这些测量值。我们的数据表中可能还会有其他措施。如果度量不相同，我们将按照相同的粘贴范围步骤进行操作，但是这次我们对“ VOLUME”执行此操作，并将数据粘贴到“ VALUE”数据下方。

Original database

desired table

我希望这是有道理的，感谢您的帮助：这是我已经实现的代码：

 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

尝试将表格从一张纸复制到另一张纸，但格式不同。 Excel VBA

0 个答案: