Как я могу проверить, существует ли конкретное имя столбца на другом листе.Если нет, создайте это?

Question

Я строю макрос для реструктуризации необработанных баз данных в новые структурированные базы данных.

Он ищет конкретные показатели (значение, объем и т. Д.) В листе необработанных данных, а затем проверяет, существуют ли они в новых данных.лист.

Если они существуют, он вытягивает данные из необработанных данных в новые данные.

Лист «Необработанные данные»:

Например,Я хочу реализовать код, который начинается с верхней ячейки, пока не найдет меру типа «Значение», а затем проверит в листе «Новые данные», существует ли он.Если это так, он вставляет данные из первых необработанных данных ниже «Значение». Если нет, он создает новый столбец с заголовком «Значение».

Лист «Новые данные»:

Вот мой код:

Sub test()

    Dim datash As Worksheet
    Dim datarng As Range
    Dim tsh As Worksheet
    Dim startrng As Range
    Dim endrng As Range
    Dim copyrng As Range
    Dim r2 As Range

    'Set tsh = Sheets.Add
    'ActiveSheet.Name = "Data"

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

    Do Until datarng = ""
       Set datarng = datarng.Offset(1, 0)
    Loop

    Set endrng = datarng(0, 1)    
    Set copyrng = datash.Range(startrng, endrng)

    Dim rng2 As Range

    Set rng2 = datash.Cells(5, 3)

    Dim measurestr As String
    Dim periodstr As String

    Do Until rng2 = ""
        measurestr = rng2(0, 1).Value
        periodstr = rng2.Value
        datash.Range(datash.Cells(startrng.Row, rng2.Column), datash.Cells(endrng.Row, rng2.Column)).Copy

        Set rng2 = rng2.Offset(0, 1)

        ' look for measures in the Data sheet
        Set r2 = ThisWorkbook.Worksheets("Data").Cells(1, findcol(ThisWorkbook.Worksheets("DEMO FOOD+OIL"), "VALUE (€)"))

        Do Until r2 = measuresrt.Value Or r2 = ""
            Set r2 = r2.Offset(0, 1)
        Loop

        'copyrng.Copy Sheets("Data").Range("A1")

        Stop



End Sub

Answer 1

Быстрый макет, не совсем подходящий для вас:

dim i as long, arr as variant, findstr as string, strcols as long, strcold as long
arr = array("Measure","Value") 'etc., you get the idea
for i = lbound(arr) to ubound(arr) step 1
    findstr = arr(i).value
    with sheets("raw data")
        strcols = .Columns(1).Find(What:=findstr, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
    end with
    with sheets("new data")
        if strcols > 0 then strcold = .Columns(1).Find(What:=findstr, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
    end with
    sheets("new data").columns(strcold).value = sheets("raw data").columns(strcols).value
next i

strcols = источник столбца строки, strcold = пункт назначения столбца строки ... позволяет искать оба, найти номер столбца, затем значение= значение.

---

Редактировать1:

Обновление для использования первого столбца листов («новые данные»)

dim i as long, lc as long, findstr as string, strcols as long
lc = sheets("new data").cells(1,sheets("new data").columns.count).end(xltoleft).column
for i = 1 to lc step 1
    findstr = sheets("new data").cells(1,i).value
    with sheets("raw data")
        strcols = .Columns(1).Find(What:=findstr, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
        if strcols > 0 then sheets("new data").columns(i).value = .columns(strcols).value
    end with
next i