【已解决】字典初学求助大佬点拨下！谢谢！（万分感谢各位大佬）

约定的童话

donghui2363 发表于 2019-6-13 10:56
If Not d.exists(t) Then
            n = n + 1
            d(t) = n

你这写法居然也可以，奇迹啊

约定的童话

wj2368 发表于 2019-6-13 11:06
If Not d.exists(t) Then
            n = n + 1
            d(t) = n

大佬这是正规的写法啊，就是else那句不太明白啥意思，能翻译一下不？

约定的童话

abc123281 发表于 2019-6-13 11:07
Sub test()
Dim i, n, arr, brr(), d As Object, t
arr = [a1].CurrentRegion

m = d(t)
    brr(m, 3) = brr(m, 3) & "," & arr(i, 3)
大佬这句怎么理解?

一把小刀闯天下

'如果A、B列有序连字典都可以不要，，，

Option Explicit

Sub test()
  Dim arr, i, m, t, dic, key
  Set dic = CreateObject("scripting.dictionary")
  arr = [a1].CurrentRegion.Offset(1)
  For i = 1 To UBound(arr, 1) - 1
    dic(arr(i, 1) & "|" & arr(i, 2)) = dic(arr(i, 1) & "|" & arr(i, 2)) & Space(1) & arr(i, 3)
  Next
  For Each key In dic.keys
    m = m + 1: t = Split(key, "|")
    arr(m, 1) = t(0): arr(m, 2) = t(1): arr(m, 3) = Trim(dic(key))
  Next
  With [h:j]
    .ClearContents
    .Resize(m, 3) = arr
  End With
End Sub

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, i, m, s
  arr = [a1].CurrentRegion.Offset(1)
  For i = 1 To UBound(arr, 1) - 1
    s = s & Space(1) & arr(i, 3)
    If arr(i, 1) <> arr(i + 1, 1) Or arr(i, 2) <> arr(i + 1, 2) Then
      m = m + 1
      arr(m, 1) = arr(i, 1): arr(m, 2) = arr(i, 2): arr(m, 3) = Mid(s, 2)
      s = vbNullString
    End If
  Next
  With [h:j]
    .ClearContents
    .Resize(m, 3) = arr
  End With
End Sub

changhong8

像是一个指针指向第一个出现的位置，然后合并某一列的信息

约定的童话

一把小刀闯天下 发表于 2019-6-13 11:28
Option Explicit

Sub test()

感谢刀哥，学习了！

wj2368

约定的童话 发表于 2019-6-13 11:17
大佬这是正规的写法啊，就是else那句不太明白啥意思，能翻译一下不？

条件句中，条件成立
if  条件成立 then
执行
else‘条件不成立执行下一句，相当否则
执行

end if
翻译成中文是否则，字典有了，就加上

micch

学习学习

1. Sub test1() '循环加入字典，然后循环得到结果
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = [a1].CurrentRegion
   
4.     For i = 2 To UBound(arr)
   
5.         d(arr(i, 1) & "|" & arr(i, 2)) = d(arr(i, 1) & "|" & arr(i, 2)) & " " & arr(i, 3)
   
6.     Next
   
7.     ReDim ar(1 To d.Count, 1 To 3)
   
8.     For Each x In d.keys
   
9.         n = n + 1
   
10.         ar(n, 1) = Split(x, "|")(0)
    
11.         ar(n, 2) = Split(x, "|")(1)
    
12.         ar(n, 3) = Mid(d(x), 2)
    
13.     Next
    
14.     [h11].Resize(d.Count, 3) = ar
    
15. End Sub
    
16. Sub test2() '一次循环得到结果数组
    
17.     Set d = CreateObject("scripting.dictionary")
    
18.     arr = [a1].CurrentRegion
    
19.     ReDim ar(1 To UBound(arr), 1 To 3)
    
20.     For i = 2 To UBound(arr)
    
21.         t = arr(i, 1) & "|" & arr(i, 2)
    
22.         If d.exists(t) Then
    
23.             ar(d(t), 3) = ar(d(t), 3) & " " & arr(i, 3)
    
24.         Else
    
25.             n = n + 1
    
26.             d(t) = n
    
27.             ar(n, 1) = arr(i, 1)
    
28.             ar(n, 2) = arr(i, 2)
    
29.             ar(n, 3) = arr(i, 3)
    
30.         End If
    
31.     Next
    
32.     [h21].Resize(n, 3) = ar
    
33. End Sub
    
34. Sub test3() '非字典，数组循环，默认打卡日期是升序
    
35.     arr = [a1].CurrentRegion
    
36.     ReDim ar(1 To UBound(arr), 1 To 3)
    
37.     For i = 2 To UBound(arr)
    
38.         If arr(i, 2) = arr(i - 1, 2) Then
    
39.             ar(n, 3) = ar(n, 3) & " " & arr(i, 3)
    
40.         Else
    
41.             n = n + 1
    
42.             ar(n, 1) = arr(i, 1)
    
43.             ar(n, 2) = arr(i, 2)
    
44.             ar(n, 3) = arr(i, 3)
    
45.         End If
    
46.     Next
    
47.     [h31].Resize(n, 3) = ar
    
48. End Sub

复制代码

约定的童话

micch 发表于 2019-6-14 13:01
学习学习

全面的写法，学习了，感谢大佬