|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
- Option Explicit
- Sub zh()
- Dim arr, brr, crr, d As New Dictionary, n, m, i, j
- arr = Sheet1.Range("a2:f" & Sheet1.Cells(Rows.Count, 1).End(xlUp).Row)
- For i = 1 To UBound(arr)
- For j = 2 To 6
- If arr(i, j) <> "" Then
- If Not d.Exists(i & j) Then d.Add (i & j), arr(i, j) & "-" & arr(i, 1)
- Else
- If Not d.Exists(i & j) Then d.Add (i & j), ""
- End If
- Next
- Next
- brr = d.Items
- ReDim crr(UBound(brr) / 5, 1 To 5)
- For i = 0 To UBound(brr) Step 5
- crr(i / 5, 1) = brr(i)
- crr(i / 5, 2) = brr(i + 1)
- crr(i / 5, 3) = brr(i + 2)
- crr(i / 5, 4) = brr(i + 3)
- crr(i / 5, 5) = brr(i + 4)
- Next
- Sheet1.[g2].Resize(UBound(arr), 5).ClearContents
- Sheet1.[g2].Resize(UBound(arr), 5) = crr
- End Sub
复制代码 |
|