不规则 转置函数

高冷cool

代码在VBA里自取

我走我流

=IFNA(DROP(REDUCE("",B6:B15,LAMBDA(x,y,IF(LEN(y),VSTACK(x,HSTACK(y,TOROW(OFFSET(y,,1,MATCH(1=0,OFFSET(y,1,):B16="",-1))))),x))),1),"")

逐渐陌生

cnmlgb9998

这样？？？？？？？？？？？？？？？？

槐序三冬

1. Sub supernova()
   
2.     Set a = ActiveSheet
   
3.     Set Rng = Selection
   
4.     x = Rng.Rows.Count
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     d_key = ""
   
7.     For i = 1 To x
   
8.         If Rng.Cells(i, 1) <> "" Then
   
9.             d_key = Rng.Cells(i, 1)
   
10.         End If
    
11.         d(d_key) = d(d_key) & "||" & Trim(Rng.Cells(i, 2))
    
12.     Next
    
13.     Set Rng = Application.InputBox("你打算放哪呢？", "还磨蹭什么呢？", Type:=8)
    
14.     row_1 = Rng.Row
    
15.     col_1 = Rng.Column
    
16.     For Each k In d.keys
    
17.         m = col_1
    
18.         a.Cells(row_1, col_1) = k
    
19.         arr = Split(d(k), "||")
    
20.         For j = 1 To UBound(arr)
    
21.             a.Cells(row_1, m + 1) = arr(j)
    
22.             m = m + 1
    
23.         Next
    
24.         row_1 = row_1 + 1
    
25.     Next
    
26. End Sub
    
27. Sub supernova()
    
28.     Set a = ActiveSheet
    
29.     Set Rng = Selection
    
30.     x = Rng.Rows.Count
    
31.     Set d = CreateObject("scripting.dictionary")
    
32.     d_key = ""
    
33.     For i = 1 To x
    
34.         If Rng.Cells(i, 1) <> "" Then
    
35.             d_key = Rng.Cells(i, 1)
    
36.         End If
    
37.         d(d_key) = d(d_key) & "||" & Trim(Rng.Cells(i, 2))
    
38.     Next
    
39.     Set Rng = Application.InputBox("你打算放哪呢？", "还磨蹭什么呢？", Type:=8)
    
40.     row_1 = Rng.Row
    
41.     col_1 = Rng.Column
    
42.     For Each k In d.keys
    
43.         m = col_1
    
44.         a.Cells(row_1, col_1) = k
    
45.         arr = Split(d(k), "||")
    
46.         For j = 1 To UBound(arr)
    
47.             a.Cells(row_1, m + 1) = arr(j)
    
48.             m = m + 1
    
49.         Next
    
50.         row_1 = row_1 + 1
    
51.     Next
    
52. End Sub

复制代码