excel - 从单元格中删除所有图像,除了 vba 中的最后一个
问题描述
我在单元格中有相同的图像,所以我想删除除最后一个之外的所有图像(只保留一个)。
我有下面的代码,但它只适用于一个单元格。我看到删除代码有问题。
Sub CellImageCheck() '' Delete multiple images in cells
Dim checkRange As Range
Dim x As Shape
Dim flag As Boolean
'On Error Resume Next
Dim WorkRng As Range
Set WorkRng = Range("E1:E372")
For Each x In ActiveSheet.Shapes
m = Range(x.TopLeftCell.Address).Row
Cells(m, 7).Value = Cells(m, 7).Value + 1 '' write image count from cell in respetice row in E column
Next
''' Delete all images in cell except last
For Each x In ActiveSheet.Shapes
m = Range(x.TopLeftCell.Address).Row
For Each Rng In WorkRng
If Cells(m, 7).Value > 1 Then
Cells(m, 7).Value = Cells(m, 7).Value - 1
x.Delete
End If
Next
Next
End Sub
解决方案
您可以使用字典来跟踪哪些单元格已与形状关联,然后删除也与同一单元格关联的任何“额外”形状。
Sub CellImageCheck()
Dim i As Long, addr, dict As Object
Set dict = CreateObject("scripting.dictionary")
For i = ActiveSheet.Shapes.Count To 1 Step -1
With ActiveSheet.Shapes(i)
addr = .TopLeftCell.Address(0, 0)
If Not dict.exists(addr) Then
dict.Add addr, True 'first shape over this cell
Else
.Delete 'already have a shape for this cell
End If
End With
Next i
End Sub
推荐阅读
- context-free-grammar - Rascal 中有没有办法从其相应的数据类型生成语法的语法定义?
- python - 有自定义刻度时将条形值添加到子条形图中
- node.js - NodeJS 用户授权获取特定数据
- sql - 使用连接从 2 个表中选择 2 列
- android - 引用我的代码中的一行时没有错误地崩溃
- javascript - 当它们可能为空时,将 GraphQL 值与 React 一起使用
- python - 我想在这些元组中创建标签
- java - NiFi:发送流文件@OnflowFile
- laravel - 迁移不更新数据库
- python - 如何在基于数组的列表中实现 remove() 方法?