Excel 如何使用dictionary对象查找和组合工作表中重复标题中的数据

我试图将第一个图像中存在的数据（带有标记）放入dictionary对象中（我刚刚了解到），查找重复的标题（在本例中为“P8”条目），然后获取重复项并将其与该标题的第一个匹配项相结合，然后转到并删除与重复标题关联的部分。第二幅图（没有标记）是数据在说了和做了之后的样子。请注意，“Pinalables:[]现在有多个数据实例组合在一个实例中

这是我设法拼凑起来的代码（我不是一个凭空想象的程序员，我写的最后一个VBA程序是5年前，花了我一辈子的时间，我只是被这项任务困住了，因为据我所知，这是我们小团队中最有用的）我知道它缺少一些关键元素，比如正确加载密钥，这是因为我无法从我读过的文章和代码中完全理解如何做到这一点。我知道一般的组织步骤，我只是有点不知道如何使用dictionary对象并使其与正确的循环一起工作。因此我尝试在MSI中进行评论ng部分，以确定我认为需要发生的事情。可能还值得注意的是，本表中的数据具有非常具体的空格、逗号、括号等格式，因为我的最终输出是一个.yml输入文件，输入到另一个程序中。因此，如果我能保留格式，那就太好了

    Sub AltDictSort()

Dim Rng As Range
Dim Dn As Range
Dim n As Long
Dim nRng As Range
Dim tempDN As String
Dim TxtRng As Range

Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))

With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
    If .Exists(Dn.Value) Then
         
    'not sure this next line does what I'm intending
    tempDN = .Item(Dn.Value).Offset(2, 0) 'load Dn.Value into temp value should be something like "   pinlabels: [J2-1,J2-2,J2-3]"
    
    Dn.Value = Left(tempDN, Len(tempDN) - 15) 'Strip 15 characters from left to get "J2-1,J2-2,J2-3]"
    tempDN = Dn.Value
    Dn.Value = Right(tempDN, Len(tempDN) - 1) 'Strip 1 characters from right to get "J2-1,J2-2,J2-3"
    tempDN = (Dn.Value + "," + Dn) 'add the two strings together to get something like this "   pinlabels: [J2-1,J2-2,J2-3,J-4,J-5,J-6]"
    
    'now I need to put the combined string back into the spot of the first occurrence of a pinlabels duplicate (in this specific case A8) but need to identify location of first occurrence
    
    'now I need to delete the entire second occurrence ( second P8: and next two rows with mpn and pinlabels) no idea how to do this
    
    Else
    'I don't think anything needs to happen here but I'm not completely sure????
    End If
Next

End With
End Sub

@JohnnieL这是输入数据的文本外观，尽管在发布时它似乎丢失了格式

> connectors:   Startup-R-J2:    mpn: 436450310    pinlabels:
> [J2-1,J2-2,J2-3]
> 
>   P8:    mpn: D38999/20JE26PN    pinlabels: [P8-C,P8-D,P8-E]
> 
>   Startup-R-J1:    mpn: 436450310    pinlabels:
> [J1-4,J1-9,J1-3,J1-6,J1-7]
> 
>   P8:    mpn: D38999/20JE26PN    pinlabels: [P8-G,P8-H,P8-I,P8-J,P8-K]
> 
>   Startup-R-J3:    mpn: 170-009-272L000    pinlabels: [J3-3,J3-2,J3-1]
> 
>   P8:    mpn: D38999/20JE26PN    pinlabels: [P8-R,P8-S,P8-T]
> 
>   PTO1-J2:    mpn: 170-009-272L000    pinlabels: [J2-5,J2-6]
> 
>   P8:    mpn: D38999/20JE26PN    pinlabels: [P8-A,P8-B]
> 
>   PTO3-J2:    mpn: 170-009-272L000    pinlabels: [J2-8,J2-7]
> 
>   P8:    mpn: D38999/20JE26PN    pinlabels: [P8-N,P8-P]
> 
>   PTO3-J2:    mpn: 170-009-272L000    pinlabels: [J2-3,J2-4]
> 
>   P8:    mpn: D38999/20JE26PN    pinlabels: [P8-R,P8-S]
> 
> cables:   Startup-R-J2_P8:    wirecount: 3    gauge: 20 AWG    length:
> 100 mm    color_code: IEC
> 
>   Startup-R-J1_P8:    wirecount: 5    gauge: 22 AWG    length: 200 mm 
> color_code: IEC
> 
>   Startup-R-J3_P8:    wirecount: 3    gauge: 24 AWG    length: 300 mm 
> color_code: IEC
> 
>   PTO1-J2_P8:    wirecount: 2    gauge: 26 AWG    length: 400 mm   
> color_code: IEC
> 
>   PTO3-J2_P8:    wirecount: 2    gauge: 28 AWG    length: 500 mm   
> color_code: IEC
> 
>   PTO3-J2_P8:    wirecount: 2    gauge: 30 AWG    length: 600 mm   
> color_code: IEC
> 
> 
> connections:
> -
>   - Startup-R-J2: [J2-1,J2-2,J2-3]
>   - Startup-R-J2_P8: [1-3]
>   - P8: [P8-C,P8-D,P8-E]
> -
>   - Startup-R-J1: [J1-4,J1-9,J1-3,J1-6,J1-7]
>   - Startup-R-J1_P8: [1-5]
>   - P8: [P8-G,P8-H,P8-I,P8-J,P8-K]
> -
>   - Startup-R-J3: [J3-3,J3-2,J3-1]
>   - Startup-R-J3_P8: [1-3]
>   - P8: [P8-R,P8-S,P8-T]
> -
>   - PTO1-J2: [J2-5,J2-6]
>   - PTO1-J2_P8: [1-2]
>   - P8: [P8-A,P8-B]
> -
>   - PTO3-J2: [J2-8,J2-7]
>   - PTO3-J2_P8: [1-2]
>   - P8: [P8-N,P8-P]
> -
>   - PTO3-J2: [J2-3,J2-4]
>   - PTO3-J2_P8: [1-2]
>   - P8: [P8-R,P8-S]

---

我从一个类模块开始，它可能看起来像这样-现在我们称它为

ConnectorInfo

：

选项显式
作为字符串的公共连接符ID
公共MPN作为字符串
公共小标签为新收藏

其思想是对我们正在查看的数据进行建模；输出中表示的每个“对象”都有一个“ConnectorID”值（“P8”、“Startup-R-J1”、“PTO3-J2”等）、一个MPN值（“436450310”、“170-009-272L000”等），以及许多需要组合的pin标签，因此需要有代码可以将此

PinLabels

集合转换为字符串，用逗号分隔它们，并用方括号包装列表

因此，让我们向该类模块添加一个公共函数，它通过将集合复制到数组中，然后使用

VBA.Strings.Join

函数生成pin标签列表来实现这一点：

Public函数CombinePinLabels（）作为字符串
重拨结果（1到PinLabels.Count）为字符串
我想我会坚持多久
对于i=1到PinLabels.Count
结果（i）=标签（i）
下一个
CombinePinLabels=“[”&连接（结果“，”&“）
端函数

由于输入将以字符串形式读取PinLabel，因此我们需要一个过程（因为我们在类模块中，我们可以将其称为“方法”），该过程将为我们拼接它们，同时确保没有重复的标签；我们可以通过键入集合项来实现这一点（不需要字典，因为我们实际上没有访问键）：

公共子ParsePinLabels（ByVal inputValue作为字符串）
'期望inputValue看起来像“[123456，ABC-123，XYZ-000-ABC]”断言（即在我们搞砸之前先打断这里）：
Debug.Assert Left$（inputValue，1）=“[”
Debug.Assert Right$（inputValue，1）=“]”
'去掉前缀和括号：
Dim解析为字符串
已解析=中间$（inputValue，2，Len（inputValue-2））
变暗值
value=Strings.Split（解析为“，”）
我想我会坚持多久
对于i=LBound（值）到UBound（值）
错误时继续下一步“防止在密钥已存在时爆炸”
PinLabels.添加值（i），值（i）
出现错误时转到0'重要！
下一个
端接头

注意，这里的输入逻辑和格式基本上是无关的：需要进行的处理独立于输入格式和输出格式

那么让我们构建输出

[…]我的最终输出是一个.yml输入文件，输入到另一个程序中

一定要放弃操纵Excel对象的想法：您想要的是让代码生成一个.yml文本文件

处理输入的代码将为生成输出的代码提供一组

ConnectorInfo

对象，因此我们已经知道需要一个过程。在标准模块（例如

Module1

）中，您希望有这样一个过程：

Public Sub-GenerateOutputYML（ByVal连接器作为集合）
将接头尺寸调整为ConnectorInfo
对于连接器中的每个连接器
“待办事项
下一个
端接头

但是，我们需要将其输出到特定的文件名-让我们将其作为一个参数，并担心以后如何提供它：

Public Sub-GenerateOutputYML（ByVal文件路径作为字符串，ByVal连接器作为集合）
暗柄一样长
handle=VBA.FreeFile
在处理文件系统I/O时，“On Error GoTo CleanFail”必须处理错误
打开输出为#句柄的文件路径
打印#句柄，“连接器：”
'使用ForEach..Next循环迭代对象集合
将接头尺寸调整为ConnectorInfo
对于连接器中的每个连接器
'每个Print#语句将一行写入文本文件，
函数的作用是：写入指定的空格数以控制缩进。
打印#句柄、Spc（2）和连接器。连接器ID&“
打印#句柄、Spc（4）和“mpn:”以及connector.mpn
打印#手柄、Spc（4）和“pinlabels:”和connector.com标签
“打印#句柄”在连接器之间留下一条空行
下一个
清洁出口：
关闭#手柄
出口接头
清除失败：
MsgBox错误说明
恢复清除出口
端接头

现在剩下要做的就是将输入解析到

Connecto的
集合中
Option Explicit

Sub AltDictSort()
    
    ' Define constants.
    Const FirstCell As String = "A2"
    Const dstCell As String = "B2"
    Const setsLen As Long = 4
    
    ' Define Source Range.
    Dim rg As Range
    Dim wrCount As Long ' Worksheet Rows Count
    With Range(FirstCell)
        wrCount = .Worksheet.Rows.Count
        Set rg = .Resize(wrCount - .Row + 1) _
            .Find("pinlabels:*", , xlFormulas, xlPart, , xlPrevious)
        If rg Is Nothing Then Exit Sub
        Set rg = .Resize(rg.Row - .Row + 2) ' + 1 because last empty row
    End With
    
    ' Define Sets Count.
    Dim SetsCount As Long: SetsCount = rg.Rows.Count / setsLen
    If rg.Rows.Count Mod setsLen > 0 Then Exit Sub
    
    ' Write values from range to array.
    Dim Data As Variant: Data = rg.Value
    
    Dim rCount As Long ' Result Rows Count
    
    ' Write values from array to dictionary, and back to array.
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        
        Dim arrString() As String: ReDim arrString(1 To 2)
        Dim m As Long: m = 1
        
        Dim n As Long
        Dim iniString As String
        
        For n = 1 To SetsCount
            iniString = Data(m, 1)
            If .Exists(iniString) Then
                arrString = .Item(iniString)
                arrString(2) = combineString(arrString(2), Data(m + 2, 1))
            Else
                arrString(1) = Data(m + 1, 1)
                arrString(2) = Data(m + 2, 1)
            End If
            .Item(iniString) = arrString
            m = m + setsLen
        Next n
        
        rCount = .Count * setsLen
        ReDim Data(1 To rCount, 1 To 1)
        m = 1
        
        Dim Key As Variant
        
        For Each Key In .Keys
            Data(m, 1) = Key
            Data(m + 1, 1) = .Item(Key)(1)
            Data(m + 2, 1) = .Item(Key)(2)
            m = m + setsLen
        Next Key
    
    End With
    
    With rg.Worksheet.Range(dstCell)
        .Resize(wrCount - .Row + 1).ClearContents
        .Resize(rCount).Value = Data
    End With

End Sub

Function combineString( _
    ByVal str1 As String, _
    ByVal str2 As String, _
    Optional ByVal lChar As String = "[", _
    Optional ByVal rChar As String = "]", _
    Optional ByVal Delimiter As String = ",") _
As String
    Dim lPos As Long: lPos = InStr(1, str1, lChar)
    Dim lStr As String: lStr = Left(str1, lPos)
    Dim r1Pos As Long: r1Pos = InStr(1, str1, rChar)
    Dim rStr As String: rStr = Right(str1, Len(str1) - r1Pos + 1)
    Dim m1str As String: m1str = Mid(str1, lPos + 1, r1Pos - lPos - 1)
    Dim r2Pos As String: r2Pos = InStr(1, str2, rChar)
    Dim m2str As String: m2str = Mid(str2, lPos + 1, r2Pos - lPos - 1)
    combineString = lStr & m1str & Delimiter & m2str & rStr
End Function