Excel VBA:计算ID编号的唯一类别的数量

时间:2018-07-19 11:09:37

标签: vba excel-vba

第一栏中有ID号,第二栏中有技术类别。

数据示例如下;

<table style="border-collapse:collapse;border-spacing:0"><tr><th style="font-family:Arial, sans-serif;font-size:14px;font-weight:normal;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:inherit;vertical-align:top">ID</th><th style="font-family:Arial, sans-serif;font-size:14px;font-weight:normal;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black;vertical-align:top">Tech-category</th></tr><tr><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black;vertical-align:top">SA091</td><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black;vertical-align:top">H4</td></tr><tr><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black;vertical-align:top">SA091</td><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black;vertical-align:top">H3</td></tr><tr><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black;vertical-align:top">SA091</td><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black;vertical-align:top">H2</td></tr><tr><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black;vertical-align:top">EP82</td><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black;vertical-align:top">K2</td></tr><tr><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black;vertical-align:top">EP82</td><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black;vertical-align:top">K2</td></tr><tr><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black;vertical-align:top">EP82</td><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black;vertical-align:top">H4</td></tr><tr><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black;vertical-align:top">EP93</td><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black;vertical-align:top">T0</td></tr><tr><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black;vertical-align:top">EP93</td><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black;vertical-align:top">T0</td></tr><tr><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black;vertical-align:top">TB99</td><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black;vertical-align:top">Y2</td></tr></table>

,我想计算每个ID的技术类别的数量,并且每个ID仅输出一个结果。使结果看起来像这样;

<table style="border-collapse:collapse;border-spacing:0"><tr><th style="font-family:Arial, sans-serif;font-size:14px;font-weight:normal;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black">Result</th><th style="font-family:Arial, sans-serif;font-size:14px;font-weight:normal;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black">n-Tech categories</th></tr><tr><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black">SA091</td><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black">3</td></tr><tr><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black">EP82</td><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black">2</td></tr><tr><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black;vertical-align:top">EP93</td><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black;vertical-align:top">1</td></tr><tr><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black;vertical-align:top">TB99</td><td style="font-family:Arial, sans-serif;font-size:14px;padding:10px 5px;border-style:solid;border-width:1px;overflow:hidden;word-break:normal;border-color:black;vertical-align:top">1</td></tr></table>

我是VBA的新手,并尝试使功能nTechAreas具有循环和If语句。

Function nTechAreas(key As String, key_array As Range, codes As Range) As Integer
    Dim n As Range
    For i = 1 To key_array.Height
        If key_array(i) = key Then
            If IsNotInArray(codes(i), n) Then
                n(i) = codes.Value
            End If
        End If
    Next i
    nTechAreas = n.Length
End Function

Function IsNotInArray(str As String, arr As Variant) As Boolean
    IsNotInArray = Not ((UBound(Filter(arr, str)) > -1))
End Function

但是,我无法使其正常工作。此外,我还认为在Excel VBA中可能存在一种更轻松/更优雅/更简单的方式来处理数据。因此,我尝试使用AutoFilter(),但还没有使其正常工作。

Function nTech(key As String) As Integer

this.Sheets(13).Activate
ActiveSheet.Range("A:G").Select
Selection.AutoFilter Gield:=1, Critera1:=key

End Function

需要帮助。

2 个答案:

答案 0 :(得分:1)

类似这样的事情。不确定这是最好的方法,只是玩了一次

Sub uniques()

Dim dicCodes As New Scripting.Dictionary
Dim dicContents As Scripting.Dictionary
Dim rngCodes As Range
Dim rngInspect As Range

Set rngCodes = Range("a1:a10")

For Each rngInspect In rngCodes.Cells

    If dicCodes.Exists(rngInspect.Value) Then

        Set dicContents = dicCodes(rngInspect.Value)
        If dicContents.Exists(rngInspect.Offset(0, 1).Value) Then
            dicContents(rngInspect.Offset(0, 1).Value) = _
                dicContents(rngInspect.Offset(0, 1).Value) + 1
        Else
            dicContents.Add rngInspect.Offset(0, 1).Value, 1
        End If

    Else

        Set dicContents = New Scripting.Dictionary
        dicContents.Add rngInspect.Offset(0, 1).Value, 1
        dicCodes.Add rngInspect.Value, dicContents

    End If

Next rngInspect

Dim lngOutput As Long
Dim lngOutputInner As Long

For lngOutput = 0 To dicCodes.Count - 1

    For lngOutputInner = 0 To dicCodes.Items()(lngOutput).Count - 1

        Debug.Print dicCodes.Keys()(lngOutput), _
                    dicCodes.Items()(lngOutput).Keys()(lngOutputInner), _
                    dicCodes.Items()(lngOutput).Items()(lngOutputInner)

    Next lngOutputInner

Next lngOutput

End Sub

答案 1 :(得分:1)

使用词典字典。将结果写在读取的值旁边。

Option Explicit
Public Sub testing()
    Dim arr(), i As Long, dict
    Set dict = CreateObject("Scripting.Dictionary")

    With ActiveSheet
        arr() = .Range("A2:B10").Value
        For i = LBound(arr, 1) To UBound(arr, 1)
            If Not dict.Exists(arr(i, 1)) Then
                dict.Add arr(i, 1), CreateObject("Scripting.Dictionary")
                dict(arr(i, 1)).Add arr(i, 2), 1
             Else
                If Not dict(arr(i, 1)).Exists(arr(i, 2)) Then
                    dict(arr(i, 1)).Add arr(i, 2), 1
                Else
                    dict(arr(i, 1))(arr(i, 2)) = dict(arr(i, 1))(arr(i, 2)) + 1
                End If
            End If
        Next i
        Dim key As Variant
        i = 1
        For Each key In dict.keys
            i = i + 1
            .Cells(i, 3) = key
            .Cells(i, 4) = dict(key).Count
        Next key
    End With
End Sub