在 Excel 中查找最常见的数字组合

Question

我是这个论坛的新手，但在浏览了几篇与我正在搜索的内容相似的帖子后，我决定自己发布一篇，因为已经发布的那些显然不适用于我的问题。但是，如果发布的代码可能适用于我的情况，请让我知道我应该更改哪些内容以使其正常工作并道歉，我是新手..

我有一个工作表，其中包含从 1 到 90 的数字集，每行有 5 个随机数，例如：23 34 56 02 10

我希望能够在 Excel 中找到的是我拥有的多行中 3 或 4 个数字的最常见组合，这是一个例子：

23 34 56 02 10

10 52 34 23 02

56 02 10 22 33

42 05 08 76 51

23 56 02 10 15

88 86 56 10 03

等等...意思是这个简短示例中最常见的 4 数字组合是 23 56 02 10

当然，基于此，我必须分析的数据总是以五组为一组，但达到 1000 多行。

是否有可以在 VBA 中实现的代码或可以用来帮助我确定相同数字在每一行中出现的频率？

我已经使用直方图对数字进行了独立处理，但现在我想查看相似数字确实一起出现的组合数量。

提前感谢您的帮助。我是一个新手，所以如果你能逐步解释我必须做什么，我将不胜感激。

Answer 1

结果将粘贴在排序后的工作表 2 中。选择显示所有值的原因是因为在许多情况下，您的数字具有相同的重复次数。最后，我认为您犯了一个错误，因为重复次数较多的四个数字是 23、34、56、2。

试试：

Option Explicit

Sub test()

    Dim LastRowS1A As Long, LastRowS2A As Long, Times As Long, i As Long, y As Long
    Dim str1 As String, str2 As String

    LastRowS1A = Sheet1.Cells(Sheet1.Rows.Count, "E").End(xlUp).Row

    For i = 1 To LastRowS1A

        str1 = Sheet1.Range("A" & i).Value & " " & Sheet1.Range("B" & i).Value & " " & Sheet1.Range("C" & i).Value & " " & Sheet1.Range("D" & i).Value & " " & Sheet1.Range("E" & i).Value

        LastRowS2A = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row

        If Application.WorksheetFunction.CountIf(Sheet2.Range("A1:A" & LastRowS2A), str1) = 0 Then

            Times = 1

            For y = i + 1 To LastRowS1A

                str2 = Sheet1.Range("A" & y).Value & " " & Sheet1.Range("B" & y).Value & " " & Sheet1.Range("C" & y).Value & " " & Sheet1.Range("D" & y).Value & " " & Sheet1.Range("E" & y).Value

                If str1 = str2 Then
                    Times = Times + 1
                End If

            Next y

            Sheet2.Range("A" & LastRowS2A + 1).Value = str1
            Sheet2.Range("B" & LastRowS2A + 1).Value = Times

        End If

    Next i


    LastRowS2A = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row

    Sheet2.Range("A2:B" & LastRowS2A).Sort Key1:=Sheet2.Range("B1"), Order1:=xlDescending, Header:=xlNo

结束子

表 1：

表 2：

Answer 2

Option Explicit

Sub Delete_Columns_G_to_Q()
    Range("G:Q").Delete
    ActiveWorkbook.Save
End Sub

Sub Main_without_Sort()

    'uncomment if you want to write sample data
    'Call SampleData

    CreateNumbers
    CopyResults
    CreatePivot

End Sub

Sub Main_including_Sort()

    'uncomment if you want to write sample data
    'Call SampleData

    SortEverySingleRow_by_Column
    CreateNumbers
    CopyResults
    CreatePivot

End Sub

Sub SampleData()

Dim a(10) As String
Dim b() As String
Dim numParts As Integer
Dim iCt As Integer
Dim jCt As Integer

a(1) = "23 34 56 02 10"
a(2) = "10 52 34 23 02"
a(3) = "56 02 10 22 33"
a(4) = "42 05 08 76 51"
a(5) = "23 56 02 10 15"
a(6) = "88 86 56 10 03"

With Range("A:F")
    .HorizontalAlignment = xlCenter
End With

For iCt = 1 To 6
    b = Split(a(iCt), " ")
    numParts = UBound(b) + 1
    Range(Cells(iCt, 1), Cells(iCt, numParts)).Value = b
    For jCt = 1 To 5
        Cells(iCt, jCt).Value = Cells(iCt, jCt).Value
        Debug.Print Cells(iCt, jCt).Address
    Next jCt
Next iCt
End Sub

Sub SortEverySingleRow_by_Column()
Dim iCt As Integer
Dim sortRange As Range

For iCt = 1 To 6
    Set sortRange = Range("A1:E1")
    If iCt > 1 Then
        Set sortRange = Range("A1:E1").Offset(iCt - 1, 0)
    End If
    'Debug.Print sortRange.Address
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=sortRange, _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange sortRange
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
Next iCt

End Sub

Sub CreateNumbers()

Dim iCt As Integer
Dim jCt As Integer

With Columns("G:M")
    .ColumnWidth = 13
    .HorizontalAlignment = xlCenter
End With

For iCt = 0 To 5
    Range("G1").Offset(iCt, 0).Select
    Call CreateFormulas
Next iCt

End Sub


Sub CreateFormulas()
    ActiveCell.FormulaR1C1 = _
        "=TEXT(RC[-6],""00"")& "" "" & TEXT(RC[-5],""00"")& "" "" & TEXT(RC[-4],""00"")& "" "" & TEXT(RC[-3],""00"")"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = _
        "=TEXT(RC[-7],""00"")& "" "" & TEXT(RC[-6],""00"")& "" "" & TEXT(RC[-5],""00"")& "" "" & TEXT(RC[-3],""00"")"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = _
        "=TEXT(RC[-8],""00"")& "" "" & TEXT(RC[-7],""00"")& "" "" & TEXT(RC[-5],""00"")& "" "" & TEXT(RC[-4],""00"")"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = _
        "=TEXT(RC[-9],""00"")& "" "" & TEXT(RC[-7],""00"")& "" "" & TEXT(RC[-6],""00"")& "" "" & TEXT(RC[-5],""00"")"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = _
        "=TEXT(RC[-9],""00"")& "" "" & TEXT(RC[-8],""00"")& "" "" & TEXT(RC[-7],""00"")& "" "" & TEXT(RC[-6],""00"")"
End Sub

Sub CopyResults()
Dim lastRow As Long
Dim colCt As Integer

    lastRow = Range("G1").SpecialCells(xlCellTypeLastCell).Row
    'Debug.Print lastRow

    Range("M1").Value = "RESULTS"

    For colCt = 1 To 5
        Range("F1:F" & lastRow).Offset(0, colCt).Copy
        'Debug.Print Range("F1:F" & lastRow).Offset(0, colCt).Address
        Range("M2").Offset(lastRow * (colCt - 1), 0).PasteSpecial xlPasteValues
        'Range("M2").Offset(lastRow * (colCt - 1), 1).Value = "colCt = " & colCt
        Application.CutCopyMode = False
    Next colCt

    Range("N1").Select
End Sub

Sub CreatePivot()

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        Range("M1").CurrentRegion, Version:=xlPivotTableVersion15).CreatePivotTable _
        TableDestination:="Sheet1!R1C15", TableName:="PivotTable1", DefaultVersion _
        :=xlPivotTableVersion15
    Sheets("Sheet1").Select
    Cells(1, 15).Select
    Range("P5").Select
    With ActiveSheet.PivotTables("PivotTable1")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("RESULTS")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("RESULTS"), "Sum of RESULTS", xlSum
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Sum of RESULTS")
        .Caption = "Count of RESULTS"
        .Function = xlCount
    End With
    ActiveSheet.PivotTables("PivotTable1").PivotFields("RESULTS").AutoSort _
        xlDescending, "Count of RESULTS", ActiveSheet.PivotTables("PivotTable1"). _
        PivotColumnAxis.PivotLines(1), 1
    Range("G1").Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("RESULTS")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveWorkbook.ShowPivotTableFieldList = False
End Sub