我将如何检查是否一个特定的列名在不同的工作表存在。如果没有，创建它吗？

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 =字符串列目的地......让你搜索两个，发现列数，则值=价值。

---

EDIT1

更新使用的片材的第一列（“新数据”）

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