|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
本帖最后由 wodewan 于 2019-11-16 20:32 编辑
根据TIM-TAO提醒,更正下(将M=1位置移动到循环外),大意了,多谢TIM-TAO的提醒。
Option Explicit
Sub test()
Dim d As Object, i&, j&, temp
Dim s, t, m&, arr, brr()
Set d = CreateObject("scripting.dictionary")
arr = Sheet1.Range("a1").CurrentRegion.Offset(1)
ReDim brr(1 To UBound(arr), 1 To 100)
m = 1
For i = 2 To UBound(arr) - 1
arr(i, 2) = Replace(arr(i, 2), ":", ":")
s = Split(arr(i, 2), Chr(10))
For j = 0 To UBound(s)
If InStr(s(j), ":") Then
t = Split(s(j), ":")
brr(1, 1) = arr(1, 1)
brr(i, 1) = arr(i, 1)
If Not d.exists(t(0)) Then
m = m + 1: d(t(0)) = m
brr(1, m) = t(0): brr(i, m) = t(1)
Else
brr(i, d(t(0))) = t(1)
End If
End If
Next
Next
Range("D2").Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub
|
评分
-
2
查看全部评分
-
|