不能删除行

wzd028

点击“删除无图片行”按钮，删除无图片的数据行，但是运行时A2、A6行不能删除，不知道哪里出错。请各位老师帮忙，谢谢！
     


    001.rar (985.42 KB, 下载次数: 10)

2024-1-18 10:22 上传

点击文件名下载附件

半百

喂你吃粑粑

半百 发表于 2024-1-18 11:09

1. Sub 删除无图片行()
   
2. Dim Arr, i&, Myr&, Shp As Shape, rng As Range
   
3. Dim d, k
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. Application.ScreenUpdating = False
   
6. Application.DisplayAlerts = False
   
7. tm = Timer
   
8. Sheet1.Activate
   
9. Myr = Cells(Rows.Count, 1).End(xlUp).Row
   
10. Arr = Range("a5:L" & Myr)
    
11. For Each Shp In Sheet1.Shapes
    
12.     If Shp.Left > [h1].Left Then
    
13.         d(Shp.TopLeftCell.Row) = ""
    
14.     End If
    
15. Next
    
16. k = d.keys
    
17. For i = UBound(Arr) To 1 Step -1
    
18.     If Not d.exists(Arr(i, 1) + 4) Then
    
19.         Range("a" & Arr(i, 1) + 4).EntireRow.Delete
    
20.     End If
    
21. Next
    
22. Myr = Cells(Rows.Count, 1).End(xlUp).Row
    
23. For i = 5 To irow
    
24.     Range("a" & i) = i - 4
    
25. Next
    
26. Application.ScreenUpdating = True
    
27. Application.DisplayAlerts = True
    
28. MsgBox "删除无图片行完毕，共用时： " & Format(Timer - tm) & "秒！"
    
29. End Sub

复制代码

喂你吃粑粑

你的后半段代码好复杂

准提部林

刪除無圖片的行...by.准提部林
Sub Test_A1()
Dim R&, P As Picture, X&
R = Cells(Rows.Count, 1).End(3).Row + 1
ReDim Arr(1 To R, 0)
For Each P In ActiveSheet.Pictures
    X = P.TopLeftCell.Row
    Arr(X - 4, 0) = X
Next P
With Range("z5").Resize(R)
     .Value = Arr
     .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
     .EntireColumn.Delete
End With
End Sub

准提部林

刪除無圖片的行..by.准提部林
代碼審核中, 上圖....借用Z列當刪行輔助