检查列的顺序

Question

我有一个 Excel 模板，其中的列按以下顺序排列：

Clientname    Date    Id    Campaign    Websitename    Frequency    Clicks    Mediacost 

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

websitename    Frequency    Clicks    Mediacost    Clientname    Date    Id   Campaign 

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

Answer 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 的评论和 Tim Williams 的回答。最好将我用作第二个Join 参数的逗号更改为Chr(0)s，或者一些模糊的东西。使用逗号，如果标题也包含逗号，则可能会得到错误匹配。

Answer 2

这个怎么样？想象一下工作簿中有两张表，标题为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

Answer 3

我认为你问错了问题。

您告诉我们数据源中的列与模板中的列的顺序不同。因此，数据源中的列永远不会与模板中的列匹配。您想要的代码将按名称匹配列并构建将源列与目标列相关联的数组。

下面的代码构建数组 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

Answer 4

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

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

如果您在 VBA 中执行此操作，源和目标可以在不同的工作表上。如果您在 Excel 中执行此操作，它们必须在同一张纸上。希望这对某人有所帮助。