[已解决]当图片邂逅合并单元格，当vlookup遇上图片

zjdh

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "$F$1" Then
        Set Rng = Sheets("数据库").Columns(1).Find(Target.Value, lookat:=xlWhole)
        If Not Rng Is Nothing Then
            Set c = [C2].MergeArea
            Range("B2") = Rng.Offset(, 1)
            Range("B3") = Rng.Offset(, 2)
            Range("B4") = Rng.Offset(, 3)
            For Each shp In ActiveSheet.Shapes    '删除图片
                If shp.Type = msoAutoShape Then shp.Delete
            Next
            Set PC = Range("C2").MergeArea
            Rng.Offset(, 4).Copy PC       '复制图片
            For Each SP In Shapes         '调整大小
                With SP
                    .Height = PC.Height
                    .Width = PC.Width
                End With
            Next
        End If
    [f1].Select
    End If
   
    If Target.Address = "$B$2" Then
        Set Rng2 = Sheets("数据库").Columns(2).Find(Target.Value, lookat:=xlWhole)
        If Not Rng2 Is Nothing Then
            Set c = [C2].MergeArea
            Range("f1") = Rng2.Offset(, -1)
            Range("B3") = Rng2.Offset(, 1)
            Range("B4") = Rng2.Offset(, 2)
            For Each shp In ActiveSheet.Shapes    '删除图片
                If shp.Type = msoAutoShape Then shp.Delete
            Next
            Set PC = Range("C2").MergeArea
            Rng2.Offset(, 3).Copy PC       '复制图片
            For Each SP In Shapes         '调整大小
                With SP
                    .Height = PC.Height
                    .Width = PC.Width
                End With
            Next
        End If
    End If
    Application.EnableEvents = True
End Sub

zjdh

复制图片2.rar (148.55 KB, 下载次数: 7)

2016-4-11 20:00 上传

点击文件名下载附件

lingyuncelia1

zjdh 发表于 2016-4-11 20:00

简洁、高效