Question

我需要在Range＆＃34; B＆＃34;中连接单元格。根据范围标准＆＃34; A＆＃34; ＆安培; ＆＃34; C＆＃34 ;.最初我试图使用Arrays编写代码来存储价值，但似乎没有用。

例如：

标准优秀：

结果：

基于这个例子，结果应该反映在范围的第一个标准＆＃34; C＆＃34; （日期）然后根据第二个标准范围跟随连接结果（范围＆＃34; B＆＃34;）＆＃34; A＆＃34;

Answer 1

看看下面的内容。当我使用我称之为major词典和minor词典时，这可能看起来相当丑陋。 major字典使用您的日期字段作为其键值，并将minor字典保存为项目。 minor词典由您的键的标题字段组成，其值为Array，而Option Explicit Public Sub TransposeAndGroupData() Dim arr As Variant, tmp As Variant Dim dict As Object Dim i As Long, j As Long Dim k, v ' Create major dictionary Set dict = CreateObject("Scripting.Dictionary") ' Change to your sheet reference With ActiveSheet '' INPUT arr = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 3)).Value2 '' INITIAL PROCESSING For i = LBound(arr, 1) To UBound(arr, 1) ' Test if date exists in major dictionary, if not add value to dictionary and initiate minor dictionary If Not dict.exists(arr(i, 3)) Then dict.Add Key:=(arr(i, 3)), Item:=CreateObject("Scripting.Dictionary") ' Test if title exists in minor dictionary ' Add if not If Not dict(arr(i, 3)).exists(arr(i, 1)) Then ' Initiate array for chapters ReDim tmp(0) tmp(0) = arr(i, 2) ' Add to minor dictionary if title doesn't exist and add array dict(arr(i, 3)).Add Key:=arr(i, 1), Item:=tmp ' Update if exists Else ' We can't write directly to the minor dictionaries array so we first write it into a temp array before writing back tmp = dict(arr(i, 3))(arr(i, 1)) ReDim Preserve tmp(LBound(tmp) To UBound(tmp) + 1) tmp(UBound(tmp)) = arr(i, 2) dict(arr(i, 3))(arr(i, 1)) = tmp End If Next i ''OUTPUT ' Update to the first cell of where you want the destination for your data With .Cells(1, 5) ' Loop through major dictionary to generate headers For Each k In dict.keys ' Output date as heading .Offset(0, j).Value2 = k ' Set number format (Dates will be handled as longs and will output as such) .Offset(0, j).NumberFormat = "d/m/yyyy" i = 0 ReDim tmp(1 To dict(k).Count) ' Loop through minor dictionary to generate value For Each v In dict(k).keys i = i + 1 tmp(i) = v & ": " & Join(dict(k)(v), ", ") Next v .Offset(1, j).Value2 = Join(tmp, vbNewLine) j = j + 1 Next k End With End With End Sub又将章节编号分别存储为值。

还有许多其他方法可以实现您正在寻找的东西，也可能有许多更简单的方法。就个人而言，我首选的方式是我如何接近它，因为它允许我在将其写回工作表之前随时访问我的数据的每个元素。这样做的好处是，如果我愿意，我可以相当容易地继续使用数据进行更多任务（例如，我可以按字母顺序排序，按章节数等等）。我可能很难用已经连接的字符串来做这件事。

var x []int
for i := 0; i < 32 ; i++{
    x[i] = i + 1
}

Answer 2

我不确定如何在一个单元格中用新行列出它们，但你可以按照以下方式收集它们

Option Explicit

Public Sub StoryWithSoup()

    With Worksheets("Sheet11") 'change as required
        Dim arr(), i As Long
        arr = .UsedRange.Value
        Dim dict As Object
        Set dict = CreateObject("Scripting.Dictionary")

        For i = 2 To UBound(arr, 1)
            If Not dict.exists(arr(i, 3)) Then dict.Add arr(i, 3), CreateObject("Scripting.Dictionary")
        Next i

        For i = 2 To UBound(arr, 1)
            If Not dict(arr(i, 3)).exists((arr(i, 1))) Then
                dict(arr(i, 3)).Add arr(i, 1), arr(i, 2)
            Else
                dict(arr(i, 3))(arr(i, 1)) = dict(arr(i, 3))(arr(i, 1)) & "," & arr(i, 2)
            End If
        Next i

        Dim key As Variant
        For Each key In dict.keys
            Dim key2 As Variant
            For Each key2 In dict(key).keys
                Debug.Print key & " : " & key2 & ": " & dict(key)(key2)
            Next key2
        Next key   
    End With  
End Sub

输出：

修改

从@Tom的答案中学习（为了归功于如何放入单个单元格），我可以使用他的方法输出到单个单元格

Option Explicit Public Sub StoryWithSoup() With Worksheets("Sheet11") 'change as required Dim arr(), i As Long arr = .UsedRange.Value Dim dict As Object Set dict = CreateObject("Scripting.Dictionary") For i = 2 To UBound(arr, 1) If Not dict.exists(arr(i, 3)) Then dict.Add arr(i, 3), CreateObject("Scripting.Dictionary") Next i For i = 2 To UBound(arr, 1) If Not dict(arr(i, 3)).exists((arr(i, 1))) Then dict(arr(i, 3)).Add arr(i, 1), arr(i, 2) Else dict(arr(i, 3))(arr(i, 1)) = dict(arr(i, 3))(arr(i, 1)) & "," & arr(i, 2) End If Next i With .Cells(1, 5) Dim k As Variant, tmp(), j As Long .Resize(1, dict.Count) = dict.keys For Each k In dict.keys i = 0 ReDim tmp(1 To dict(k).Count) Dim v As Variant For Each v In dict(k).keys i = i + 1 tmp(i) = v & ":" & dict(k)(v) Next v .Offset(1, j).Value2 = Join(tmp, vbNewLine) j = j + 1 Next k End With End With End Sub

根据其他范围标准连接单元格

2 个答案: