|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- Sub supernova()
- Set a = ActiveSheet
- Set Rng = Selection
- x = Rng.Rows.Count
- Set d = CreateObject("scripting.dictionary")
- d_key = ""
- For i = 1 To x
- If Rng.Cells(i, 1) <> "" Then
- d_key = Rng.Cells(i, 1)
- End If
- d(d_key) = d(d_key) & "||" & Trim(Rng.Cells(i, 2))
- Next
- Set Rng = Application.InputBox("你打算放哪呢?", "还磨蹭什么呢?", Type:=8)
- row_1 = Rng.Row
- col_1 = Rng.Column
- For Each k In d.keys
- m = col_1
- a.Cells(row_1, col_1) = k
- arr = Split(d(k), "||")
- For j = 1 To UBound(arr)
- a.Cells(row_1, m + 1) = arr(j)
- m = m + 1
- Next
- row_1 = row_1 + 1
- Next
- End Sub
- Sub supernova()
- Set a = ActiveSheet
- Set Rng = Selection
- x = Rng.Rows.Count
- Set d = CreateObject("scripting.dictionary")
- d_key = ""
- For i = 1 To x
- If Rng.Cells(i, 1) <> "" Then
- d_key = Rng.Cells(i, 1)
- End If
- d(d_key) = d(d_key) & "||" & Trim(Rng.Cells(i, 2))
- Next
- Set Rng = Application.InputBox("你打算放哪呢?", "还磨蹭什么呢?", Type:=8)
- row_1 = Rng.Row
- col_1 = Rng.Column
- For Each k In d.keys
- m = col_1
- a.Cells(row_1, col_1) = k
- arr = Split(d(k), "||")
- For j = 1 To UBound(arr)
- a.Cells(row_1, m + 1) = arr(j)
- m = m + 1
- Next
- row_1 = row_1 + 1
- Next
- End Sub
复制代码 |
|