使用通配符计算半匹配列 [英] Count semi-matching columns using wildcard

问题描述

< tbody>

字母	数字	CountOfNumbers
HT	HT1	5
HT	HT1
HT	HT1
HT	HT1
HT	HT1
HT	HT2        4
HT	HT2
HT	HT2
HT	HT2

这就是我在excel上的内容。我想计算列"数字"的数量。半匹配列"字母"。例如，HT1与HT半匹配，因为它们都以HT开头。 HT1的计数为5。实质上，HT2的计数
为4.这是我现在的VBA代码：

Sub NumbersTest（）

Dim NumbersRow As Long

  &NBSP; NumbersRow = Cells（Rows.Count，1）.End（xlUp）.Row '编辑此匹配

  &NBSP; &NBSP; &NBSP;   MsgBox NumbersRow   &NBSP;  
$
结束次级

MsgBox返回9，但我希望它返回为5和4.还有什么做我需要添加？

解决方案

以下是我对该问题的看法，了解代码的作用，

 Sub NumbersTest（）
'******************** 
'代码礼貌
'Paul Eugin 
'******************** 
 Dim totRows As Long，iCtr As Long，jCtr As Long，NumbersRow As Long 
 Dim objDict As Object，lngRow As Long，tmpR，tmpArr（），arrTot As Long 
 
'使用好旧的Dictionary对象
设置objDict = CreateObject（" Scripting .Dictionary"）
 
'获取行总数
 totRows = Cells（Rows.Count，1）.End（xlUp）.Row 
 
 tmpR = Application.Transpose（Range（" B1"，Cells（Rows.Count，" B"）。）End（xlUp）））
 
 for lngRow = 1 To UBound（tmpR，1）
 objDict（tmpR （lngRow））= 1 
下一个
 
'获取列表中的唯一总值
 arrTot = objDict.Count 
 
 ReDim tmpArr（1 To arrTot）
 
'暂时将它们存储在新列
范围内（"C1：C"） &安培; arrTot）= Application.Transpose（objDict.keys）
 
'循环遍历所有唯一值的列表
 For iCtr = 1 to arrTot 
'比较每个唯一值与相应的栏目。 
 for jCtr = 1 to totRows 
'这里是分组将发生的地方
如果Cells（iCtr，3）= Cells（jCtr，2）那么
'我们正在计算所有HT1 ，及其相应的列。 
'所有HT2及其相应的值......依此类推
 If Cells（jCtr，1）<> vbNullString和InStr（Cells（jCtr，2），Cells（jCtr，1））<> 0然后_ 
 NumbersRow = NumbersRow + 1 
结束如果
下一个
'最后对应的Unique值将结果存储在Array中。 
 tmpArr（iCtr）= NumbersRow 
 NumbersRow = 0 
下一个
 
对于iCtr = 1到arrTot 
'现在结果打印在另一列中格式。 
'HT1  -  5 
 Cells（iCtr，3）= Cells（iCtr，3）& " - " &安培; tmpArr（iCtr）
下一个
结束子

根据数据进行测试，

HT	HT1	HT1 - 5
HT	HT1	HT2 - 2
HT	HT1
HT	HT1
HT	HT1
	HT2
HT	HT2
HA	HT1
HT	HT2

Letters	Numbers	CountOfNumbers
HT	HT1	5
HT	HT1
HT	HT1
HT	HT1
HT	HT1
HT	HT2        4
HT	HT2
HT	HT2
HT	HT2

This is what I have on my excel. I want to count the number of column "numbers" semi-matching column "letters." For example, HT1 semi-matches with HT, since they both start with HT. The count for HT1 would be five. In essence, the count for HT2 would be 4. Here's my VBA code for now:

Sub NumbersTest()
Dim NumbersRow As Long
    NumbersRow = Cells(Rows.Count, 1).End(xlUp).Row  'Edit This to Matching
         MsgBox NumbersRow      
End Sub

The MsgBox returns as 9, but I want it to return as 5 and 4. What else do I need to add?

解决方案

Here is my take on the issue, understand what the code does,

Sub NumbersTest()
'********************
'Code Courtesy of
'  Paul Eugin
'********************
    Dim totRows As Long, iCtr As Long, jCtr As Long, NumbersRow As Long
    Dim objDict As Object, lngRow As Long, tmpR, tmpArr(), arrTot As Long
    
    'Uses the good old Dictionary object
    Set objDict = CreateObject("Scripting.Dictionary")
    
    'Get the total number of Rows
    totRows = Cells(Rows.Count, 1).End(xlUp).Row
    
    tmpR = Application.Transpose(Range("B1", Cells(Rows.Count, "B").End(xlUp)))
    
    For lngRow = 1 To UBound(tmpR, 1)
        objDict(tmpR(lngRow)) = 1
    Next
    
    'Get the total unique values in the list
    arrTot = objDict.Count
    
    ReDim tmpArr(1 To arrTot)
    
    'Temporarily store them in a New Column
    Range("C1:C" & arrTot) = Application.Transpose(objDict.keys)
        
    'Loop through the list of all Unique values
    For iCtr = 1 To arrTot
        'To compare each unique value against the corresponding column.
        For jCtr = 1 To totRows
            'Here is where Grouping will occur
            If Cells(iCtr, 3) = Cells(jCtr, 2) Then
                'We are counting all HT1, with its corresponding column.
                'All HT2, with its corresponding values.. so on and so forth
                If Cells(jCtr, 1) <> vbNullString And InStr(Cells(jCtr, 2), Cells(jCtr, 1)) <> 0 Then _
                    NumbersRow = NumbersRow + 1
            End If
        Next
        'Finally for the corresponding Unique value store the result in the Array.
        tmpArr(iCtr) = NumbersRow
        NumbersRow = 0
    Next
    
    For iCtr = 1 To arrTot
        'Now the results is printed in another column in the format.
        '   HT1 - 5
        Cells(iCtr, 3) = Cells(iCtr, 3) & " - " & tmpArr(iCtr)
    Next
End Sub

Tested against the data,

HT	HT1	HT1 - 5
HT	HT1	HT2 - 2
HT	HT1
HT	HT1
HT	HT1
	HT2
HT	HT2
HA	HT1
HT	HT2

这篇关于使用通配符计算半匹配列的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！