Question

我有一张excel表格，其值如下：

R1：A 1 0 1 1 0 1
  R2：B 0 0 1 1 0 0
  R3：C 1 0 1 1 0 1
  R4：D 1 0 1 1 0 1
  R5：E 0 0 1 1 0 0
  R-row

输出：
  A，C，D（因为它们具有匹配的列）
  B，E

我需要一个VBA脚本，它根据匹配的值对列进行分组。我需要在一大组数据（比如417列）和n行上运行它，请更加通用化。请帮帮我。谢谢。

Answer 1

克里斯是绝对正确的;听起来像＃34的问题;请解决我的整个问题＆＃34;在这里不太受欢迎。

我认为你很少或根本不知道VBA，也不知道从哪里开始解决这个问题。如果您输入＆＃34; Excel VBA教程＆＃34;在您最喜欢的搜索引擎中，您将获得一系列教程。尝试一下，选择你最喜欢的那个并系统地完成它。你会很快意识到你建立一个良好的理解。

但是，为了给你一个开始，我将围绕你的问题构建一个教程。我不会对单个语句说太多，因为很容易用VB帮助或搜索引擎查找它们。例如，第一个语句是Option Explicit。键入＆＃34; excel vba选项显式＆＃34;在搜索引擎中，您将获得一系列页面，这些页面解释了该语句的作用以及包含它的原因。

我假设您知道如何打开Excel，打开VB编辑器，创建模块并执行宏。如果没有，这些将是互联网上任何教程解释的第一件事。

我创建了一个包含工作表输入的工作簿。我已使用以下数据加载输入：

Sample data

第2行到第6行与您的数据匹配。我添加了一个标题行和一些不同长度的数据行。你要求一个通用的解决方案，但我不知道如何推广。这可能比你寻求的更多或更少。创建类似的工作表或根据您的要求修改下面的代码。

将以下宏 Test1 复制到VB模块并运行它。

Option Explicit
Sub Test1()

  Dim ColMax As Long
  Dim RowMax As Long

  With Worksheets("Input")

    ' There are many different ways of identifying the last used row and
    ' column.  SpecialCells has a selection of parameters and is worth
    ' knowing so I have decided to use it to identify the last row and
    ' column.

    ColMax = .Cells.SpecialCells(xlCellTypeLastCell).Column
    RowMax = .Cells.SpecialCells(xlCellTypeLastCell).Row

    ' Debug.Print outputs values to the Immediate Window which will be at the
    ' bottom of the VB Editor window.  If the Immediate Window is is missing,
    ' click Ctrl+G.

    Debug.Print "Last used column " & ColMax
    Debug.Print "Last used row " & RowMax

  End With

End Sub

使用我的数据，宏将以下内容输出到立即窗口：

Last used column 10
Last used row 13

专栏＆＃34; J＆＃34;是第10列。此代码标识了我使用的最后一行和列，如果我的宏要检查正确的行数和列数，我必须知道。将值输出到立即窗口是检查代码的简便方法。

现在将宏 Test2 添加到模块并运行它：

Sub Test2()

  Dim ColCrnt As Long
  Dim ColMax As Long

  With Worksheets("Input")

    ColMax = .Cells.SpecialCells(xlCellTypeLastCell).Column

    Debug.Print "Row 1:"
    For ColCrnt = 1 To ColMax
      Debug.Print "Col " & ColCrnt & "=" & .Cells(1, ColCrnt).Value & "  ";
      If ColCrnt Mod 5 = 0 Then
        Debug.Print
      End If
    Next

  End With

End Sub

使用我的数据，宏将以下内容输出到立即窗口：

Row 1:
Col 1=Id  Col 2=Value 1  Col 3=Value 2  Col 4=Value 3  Col 5=Value 4  
Col 6=Value 5  Col 7=Value 6  Col 8=Value 7  Col 9=Value 8  Col 10=Value 9

我仍然希望您使用VB帮助或互联网来获取我所使用的语句的描述，但我需要做一些解释。

考虑：

ColMax = Worksheets("Input").Cells.SpecialCells(xlCellTypeLastCell).Column

在宏 Test2 中，我将Worksheets("Input")与其余字符串分隔为With Statement。这使代码更快，更清晰，更小但我可以在这里编写一个字符串。

Worksheets("Input")引用整个工作表。

Worksheets("Input").X引用工作表的第X部分。我可以引用图表或默认值，但我想引用单元格。 Worksheets("Input").Cells引用工作表中的所有单元格。

Worksheets("Input").Cells.X引用部分单元格或对单元格进行操作的方法。例如，Worksheets("Input").Cells.Sort将允许我对工作表进行排序。

Worksheets("Input").Cells.SpecialCells让我可以访问一组返回Worksheets("Input").Cells信息的方法。添加一个参数给出：Worksheets("Input").Cells.SpecialCells(xlCellTypeLastCell)说明我想要的方法。

最后，我添加.Column来识别我需要的属性。

如果您要了解VBA或几乎任何现代编程语言，了解此点符号至关重要。在X.Y中，Y可以是X的一部分，X是一种适用于X或X属性的方法。

Worksheets("Input").Cells(R, C)允许我访问R行和C列的单个单元格.R是一个最小值为1的整数，最大值取决于所使用的Excel版本。 Rows.Count给出您正在使用的版本的最大行号。 C可以是整数（例如5）或列代码（例如＆＃34; E＆＃34;）。专栏＆＃34; A＆＃34;是第1栏。

Debug.Print Expression将 Expression 输出到立即窗口，并使用换行符跟随它。 Debug.Print Expression;将 Expression 输出到立即窗口，但不使用换行符跟随它。

ColCrnt Mod 5返回ColCrnt的剩余部分除以5.通过测试此余数为0，我可以每5行添加一个换行符。

我使用for循环输出第1行中的每个值。

虽然宏 Test2 只包含14个语句，但它使用了很多VBA概念。慢慢地完成它。使用F8逐个语句逐步执行宏语句并研究每个语句的作用。如果您能理解这个宏，那么您几乎知道解决问题所需的一切。

现在我们需要考虑匹配行。我不会使用有效的算法来匹配行，因为这需要更复杂的VBA。一旦掌握了知识，就可以稍后增强代码。我将使用的方法包括：

将第2行与第3,4,5,6，......行进行比较，记录匹配并记录已与前一行匹配的行。
将第3行与第6行进行比较，但不是第4和第5行，因为它们已经与第2行匹配。

为了记录匹配，我需要某种方式记录行2,4和5是相同的，而我继续发现行3,6和8是相同的。将第4行与第2行匹配后，我不想在第5行检查第5行。

我将使用布尔数组满足第二个要求：

Dim Matched() As Boolean

ReDim Matched(2 To RowMax)

For RowMast = 2 to RowMax
  Matched(RowMast) = False
Next

在Dim Matched() As Boolean中，()说我想要一个动态数组。动态数组是我可以在运行时更改上限和下限的数组。 VBA是少数几种允许动态数组的语言之一，也是允许您设置下限的语言之一。

ReDim Matched(2 To RowMax)将下限指定为2（=第一个数据行），将上限指定为RowMax（=最后一个数据行）。您经常会看到ReDim Matched(N)这样的语句，表示我想要N个条目，并让编译器根据Option Base语句确定下限（如果使用的话）。我总是指定下限，因为我不希望有人通过添加或更改Option Base语句来干扰我的数组。

以下将Matched的每个元素设置为False。这不是必需的，因为大多数现代语言初始化变量。我记得当情况并非如此，而且更愿意明确。

For RowMast = 2 to RowMax
  Matched(RowMast) = False
Next

如果P> N> M，当我将行N和P与行M匹配时，我将匹配（N）和匹配（P）设置为True，因此我不会对后面的行测试行N.

录制匹配的方法有很多种。我将使用构建字符串的粗略技术。

宏 Test3 创建搜索输出。它不是一个有效的代码片段，但它以最小的VBA完成工作。将此宏添加到模块并运行它。立即窗口的输出是您请求的输出，除了我添加的额外行：

A, C, D
B, E, G
F, J
I, L

祝VBA编程好运。

Sub Test3()

  Dim ColCrnt As Long
  Dim ColMax As Long
  Dim MatchCrnt As Boolean
  Dim Matched() As Boolean
  Dim MatchStgTotal As String
  Dim MatchStgCrnt As String
  Dim RowMast As Long    ' The master row; the row I am comparing
                         ' against later rows
  Dim RowMax As Long
  Dim RowSub As Long     ' The subordinate row; the row I am comparing
                         ' against an earlier row

  With Worksheets("Input")

    ColMax = .Cells.SpecialCells(xlCellTypeLastCell).Column
    RowMax = .Cells.SpecialCells(xlCellTypeLastCell).Row

    MatchStgTotal = ""      ' No matches discovered yet

    ' Initialise Matched
    ReDim Matched(2 To RowMax)
    For RowMast = 2 To RowMax
      Matched(RowMast) = False
    Next

    For RowMast = 2 To RowMax
      If Not Matched(RowMast) Then
        ' This row has not been matched against an earlier row

        MatchStgCrnt = ""   ' No matches for row RowMast discovered yet

        For RowSub = RowMast + 1 To RowMax
          ' Match row RowMast against every later row

          If Not Matched(RowSub) Then
            ' This row has not been matched against an earlier row

            MatchCrnt = True     ' Assume RowSub matches RowMast
                                 ' until find otherewise

            For ColCrnt = ColMax To 2 Step -1
              ' Compare cells from right to left so rows with different
              ' numbers of values fails to match quickly.  This is the only
              ' consession to efficiency in this loop.  There are much better
              ' ways of doing this but I think I have included enough VBA in
              ' this tutorial.

              If .Cells(RowMast, ColCrnt).Value <> _
                 .Cells(RowSub, ColCrnt).Value Then
                ' These rows do not match
                MatchCrnt = False
                Exit For   ' N point checking further cells
              End If

            Next

            If MatchCrnt Then
              ' Row RowSub matches RowMast

              ' Add this row's Id to the list of matches against RowMast
              MatchStgCrnt = MatchStgCrnt & ", " & .Cells(RowSub, 1).Value
              Matched(RowSub) = True  ' Do not check this row again

            End If
          End If

        Next RowSub

        If MatchStgCrnt <> "" Then
          ' RowMast has been matched against one or more other rows.
          ' MatchCrnt contains a list of those other rows.
          If MatchStgTotal <> "" Then
            ' A previous row have been matched.
            ' Terminate it's string with a newline
            MatchStgTotal = MatchStgTotal & vbLf
          End If
          MatchStgTotal = _
                     MatchStgTotal & .Cells(RowMast, 1).Value & MatchStgCrnt
        End If
      End If
      ' Note: Matched(RowMast) has not been set if row RowMast has been matched
      '       because I will never loook as row RowMast again.
    Next RowMast

  End With

  Debug.Print MatchStgTotal

End Sub

VBA excel列匹配

1 个答案: