|
- Sub niko()
- Dim wsSource As Worksheet
- Dim wsTarget As Worksheet
- Dim rngSourceLookup As Range
- Dim rngSourceImage As Range
- Dim rngTarget As Range
- Dim lookupValue As Variant
- Dim matchCell As Range
- Dim shp As Shape
- Set wsSource = ThisWorkbook.Worksheets("Sheet1")
- Set wsTarget = ThisWorkbook.Worksheets("Sheet2")
- Set rngSourceLookup = wsSource.Range("A2:A7")
- Set rngSourceImage = wsSource.Range("E2:E7")
- lookupValue = wsTarget.Range("B2").Value
- Set matchCell = rngSourceLookup.Find(lookupValue, LookIn:=xlValues, LookAt:=xlWhole)
- If Not matchCell Is Nothing Then
- Set rngTarget = wsTarget.Range("C6")
- For Each shp In wsTarget.Shapes
- If Not Intersect(shp.TopLeftCell, rngTarget) Is Nothing Then
- shp.Delete
- Exit For
- End If
- Next shp
- rngSourceImage.Cells(matchCell.Row - rngSourceLookup.Row + 1).CopyPicture Appearance:=xlScreen, Format:=xlPicture
- rngTarget.PasteSpecial
- Application.CutCopyMode = False
- End If
- End Sub
复制代码 |
评分
-
1
查看全部评分
-
|