0

我有一个具有如下值的 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 行

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

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

4

1 回答 1

2

克里斯是绝对正确的。听起来像“请解决我的整个问题”的问题在这里并不受欢迎。

我假设您对 VBA 知之甚少或一无所知，并且不知道从哪里开始解决这个问题。如果您在您喜欢的搜索引擎中输入“Excel VBA 教程”，您将获得一系列教程。尝试一些，选择你最喜欢的一个，然后系统地完成它。你会惊讶于你建立良好理解的速度之快。

但是，为了让您开始，我将围绕您的问题构建一个教程。我不会对单个语句多说，因为使用 VB Help 或搜索引擎很容易查找它们。例如，第一个语句是Option Explicit. 在搜索引擎中键入“excel vba option explicit”，您将获得一个选择页面，这些页面解释了该语句的作用以及为什么包含它是一个好主意。

我假设您知道如何打开 Excel、打开 VB 编辑器、创建模块和执行宏。如果没有，这些将是互联网上任何教程将首先解释的内容。

我用工作表Input创建了一个工作簿。我已经用以下数据加载了Input ：

样本数据

第 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

“J”列是第 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 帮助或 Internet 来获得对我使用过的语句的描述，但对我正在做的事情进行一些解释是必要的。

考虑：

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 的属性。

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

Debug.Print Expression将Expression输出到立即窗口，并在其后加上换行符。 将ExpressionDebug.Print 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 行匹配后，我不想检查第 4 行与第 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)I want N 个条目之类的语句，并让编译器根据 Option Base 语句（如果使用）来确定下限。我总是指定下限，因为我不希望有人通过添加或更改 Option Base 语句来干扰我的数组。

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

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

如果 P > N > M，当我将 N 行和 P 行与 M 行匹配时，我会将 Matched(N) 和 Matched(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
于 2012-09-24T11:59:29.457 回答