|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
结果写入E1单元格
- Sub CommandButton1_Click()
- Dim lstR, i, j, k, m, aData, sRes, dic As Object
- Set dic = CreateObject("Scripting.Dictionary")
- lstR = [a60000].End(xlUp).Row
- aData = Range([a1], Cells(lstR, 2)).Value
- For i = 1 To lstR
- If aData(i, 1) = "分隔" Then
- If dic.Count > 0 Then
- For Each k In dic.items
- If InStr(1, k, ",") > 0 Then
- sRes = sRes & Chr(10) & k
- End If
- Next
- dic.RemoveAll
- End If
- Else
- j = aData(i, 1) & aData(i, 2)
- If Len(j) > 0 Then
- If dic.exists(j) Then
- dic.Item(j) = dic.Item(j) & "," & CStr(i)
- Else
- dic.Item(j) = CStr(i)
- End If
- End If
- End If
- Next
- [E1] = Mid(sRes, 2)
- End Sub
复制代码 |
评分
-
1
查看全部评分
-
|