|
楼主 |
发表于 2024-11-28 14:24
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub InsertRowsBasedOnDuplicates()
Dim ws As Worksheet
Set ws = ActiveSheet ' 使用当前活动工作表,也可以指定工作表,例如 Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim lastRow As Long
Dim i As Long
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary") ' 使用字典来存储重复次数
' 找到Z列的最后一行
lastRow = ws.Cells(ws.Rows.count, "Z").End(xlUp).Row
' 遍历Z列,跳过首行
For i = 2 To lastRow
If dict.Exists(ws.Cells(i, "Z").Value) Then
' 如果字典中已存在该值,则增加计数
dict(ws.Cells(i, "Z").Value) = dict(ws.Cells(i, "Z").Value) + 1
Else
' 如果字典中不存在该值,则添加并设置计数为1
dict.Add ws.Cells(i, "Z").Value, 1
End If
Next i
' 再次遍历Z列,根据重复次数插入行
For i = lastRow To 2 Step -1 ' 从最后一行向上遍历,以避免插入行时改变未处理的行号
If dict.Exists(ws.Cells(i, "Z").Value) Then
Dim count As Long
count = dict(ws.Cells(i, "Z").Value)
' 根据重复次数插入行
Select Case count
Case 10
' 重复10次,不插入行
Case 9
ws.Rows(i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Case 8
ws.Rows(i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Case 7
ws.Rows(i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Case 6
ws.Rows(i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 4).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Case 5
ws.Rows(i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 4).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 5).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Case 4
ws.Rows(i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 4).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 5).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 6).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Case 3
ws.Rows(i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 4).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 5).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 6).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 7).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Case 2
ws.Rows(i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 4).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 5).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 6).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 7).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 8).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Case 1
ws.Rows(i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 4).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 5).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 6).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 7).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 8).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Rows(i + 9).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Select
' 从字典中移除已处理的项
dict.Remove (ws.Cells(i, "Z").Value)
End If
Next i
End Sub
这是用ai生成的,大佬是否有简洁的代码 |
|