检查列的顺序

时间:2014-04-12 09:22:26

标签: excel vba

我的Excel模板按以下顺序包含列:

Clientname    Date    Id    Campaign    Websitename    Frequency    Clicks    Mediacost 

我的数据源具有相同的字段,但总是以不同的顺序,例如:

websitename    Frequency    Clicks    Mediacost    Clientname    Date    Id   Campaign 

我需要一些功能来检查数据源文件中的顺序是否正确。

4 个答案:

答案 0 :(得分:1)

这个怎么样?想象一下,A1:D1中包含标题的工作簿中的两个工作表。这将比较订单并显示消息,如果不是相同的顺序:

Sub CompareFields()
    Dim templateColumns(), sourceColumns(), col As Integer

    templateColumns = Worksheets(1).Range("A1:D1").Value
    sourceColumns = Worksheets(2).Range("A1:D1").Value

    For col = 1 To UBound(templateColumns, 2)
        If templateColumns(1, col) <> sourceColumns(1, col) Then
            MsgBox "Source data not in the correct order"
            Exit For
        End If
    Next col
End Sub

答案 1 :(得分:1)

这将一次比较两张纸的整个第一行:

Sub Test()
Dim wb As Excel.Workbook
Dim Sheet1Header As Excel.Range
Dim Sheet2Header As Excel.Range

Set wb = ThisWorkbook
Set Sheet1Header = wb.Worksheets("Sheet1").Rows(1)
Set Sheet2Header = wb.Worksheets("Sheet2").Rows(1)

If Join(Application.Transpose(Application.Transpose(Sheet1Header.Value)), ",") = _
   Join(Application.Transpose(Application.Transpose(Sheet2Header.Value)), ",") Then
    MsgBox "Match!"
Else
    MsgBox "No Match"
End If
End Sub
编辑:发布后我读了Simoco的评论和蒂姆威廉姆斯回答。将我用作Join的第二个Chr(0)参数的逗号更改为{{1}} s或其他不明确的内容。使用逗号,如果标题还包含逗号,则可能会出现错误匹配。

答案 2 :(得分:1)

我认为你提出了错误的问题。

您告诉我们数据源中的列与模板中的列不同。因此,数据源中的列永远不会与模板中的列匹配。您希望代码按名称匹配列,并构建一个将源列与目标列相关联的数组。

下面的代码构建了数组ColSrcToDest(),然后将内容输出到立即窗口。对于您的示例标题,它输出:

Source   Destination
     1   5
     2   6
     3   7
     4   8
     5   1
     6   2
     7   3
     8   4

这意味着应将源列1中的数据复制到目标列5。

代码检查不匹配,并在一个工作表中构建列出名称的字符串,而不是另一个工作表。

Option Explicit
Sub MatchCols()

  Dim ColDestCrnt As Long
  Dim ColDestLast As Long
  Dim ColDestNameMissing As String
  Dim ColSrcCrnt As Long
  Dim ColSrcLast As Long
  Dim ColSrcNameNew As String
  Dim ColSrcToDest() As Long
  Dim Found As Boolean
  Dim HeadDest As Variant
  Dim HeadDestInSrc() As Boolean
  Dim HeadSrc As Variant

  With Worksheets("Source")
    ' Find last used column in header row
    ColSrcLast = .Cells(1, Columns.Count).End(xlToLeft).Column
    ' Load source header row to variant
    HeadSrc = .Range(.Cells(1, 1), .Cells(1, ColSrcLast)).Value
  End With

  With Worksheets("Destination")
    ' Find last used column in header row
    ColDestLast = .Cells(1, Columns.Count).End(xlToLeft).Column
    ' Load source header row to variant
    HeadDest = .Range(.Cells(1, 1), .Cells(1, ColDestLast)).Value
  End With

  ' Size array that will relate source columns to destination columns
  ReDim ColSrcToDest(1 To ColSrcLast)
  ' Size array that will record destination headings that found in source headings
  ReDim HeadDestInSrc(1 To ColDestLast)

  ColSrcNameNew = ""

  For ColSrcCrnt = 1 To ColSrcLast
    Found = False
    ' Search destination headings for current source heading
    For ColDestCrnt = 1 To ColDestLast
      If LCase(HeadDest(1, ColDestCrnt)) = LCase(HeadSrc(1, ColSrcCrnt)) Then
        Found = True
        Exit For
      End If
    Next
    If Found Then
      ' Current source heading found amid destination headings
      ' Record destination column for this source column
      ColSrcToDest(ColSrcCrnt) = ColDestCrnt
      ' Record current destination column found
      HeadDestInSrc(ColDestCrnt) = True
    Else
      ' Current source heading not found amid destination headings
      ' Add heading to list of new source headings
      If ColSrcNameNew <> "" Then
        ColSrcNameNew = ColSrcNameNew & "  "
      End If
      ColSrcNameNew = ColSrcNameNew & HeadSrc(1, ColSrcCrnt)
    End If
  Next

  ColDestNameMissing = ""
  For ColDestCrnt = 1 To ColDestLast
    If Not HeadDestInSrc(ColDestCrnt) Then
      If ColDestNameMissing <> "" Then
        ColDestNameMissing = ColDestNameMissing & "  "
      End If
      ColDestNameMissing = ColDestNameMissing & HeadDest(1, ColDestCrnt)
    End If
  Next

  ' If ColSrcNameNew <> "", there are columns in the source data not present
  ' in the destination heading.  This may be acceptable if you are selecting
  ' interesting columns from a fuller dataset.

  ' If ColDestNameMissing <> "", there are destination columns with no matching
  ' source column.  I assume this will be unacceptable.

  ' The data from source column N goes to destination column ColSrcToDest(N)
  ' If ColSrcToDest(N) = 0, there is no destination column for source column N.

  If ColSrcNameNew <> "" Then
    Debug.Print "ColSrcNameNew = " & ColSrcNameNew
  End If
  If ColDestNameMissing <> "" Then
    Debug.Print "ColDestNameMissing = " & ColDestNameMissing
  End If

  Debug.Print "Source   Destination"
  For ColSrcCrnt = 1 To ColSrcLast
    Debug.Print Right(Space(5) & ColSrcCrnt, 6) & "   " & _
                ColSrcToDest(ColSrcCrnt)
  Next

End Sub

答案 3 :(得分:0)

我知道这已经很老了,所以我只是为其他有类似问题的人提供这个想法。此解决方案依赖于传入的数据头与目标头完全相同,但只是以不同的顺序。 使用高级过滤器,其中列表范围是传入数据,复制到范围是目标标题(无标准范围)。 在VBA中,它看起来像这样:

ActiveSheet.Range("A1:H23").AdvancedFilter _   'The Source Data
    Action:=xlFilterCopy, _
    CopyToRange=ActiveSheet.Range("J1:Q1")      'The Target Headers

如果您在VBA中执行此操作,则源和目标可以位于不同的工作表上。如果您在Excel中执行此操作,则必须位于同一工作表中。希望这有助于某人。