|
2学分
本帖最后由 徐海洋 于 2022-5-7 17:59 编辑
表1
表2
请老师指教,输入身份证号相同,覆盖不增加,输入身份证号不同,新增记录,谢谢
[url=]简历保存.zip[/url]
本帖最后由 hasyh2008 于 2022-5-18 08:11 编辑
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim Rg As Range
Set Rg = Range("H2:H4")
If Target.Address = "$C$5" Or Target.Address = "$C$2" Then
删除图片
ActiveSheet.Shapes.AddShape(msoShapeRectangle, Rg.Left, Rg.Top, Rg.Width, Rg.Height).Select
Selection.ShapeRange.Fill.UserPicture ThisWorkbook.Path & "\图片\" & Cells(2, 3) & Cells(5, 3) & ".jpg"
End If
Set Rg = Nothing
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
Dim Arr(1 To 12), Brr, Shp As Shape
Dim Dic
Dim Rc%, K%
Set Dic = CreateObject("scripting.dictionary")
With Sheet1
Arr(1) = .Cells(2, 3): Arr(2) = .Cells(2, 5): Arr(3) = .Cells(3, 5): Arr(4) = .Cells(4, 3)
Arr(5) = .Cells(5, 3): Arr(7) = .Cells(4, 6): Arr(8) = .Cells(2, 7)
Arr(9) = .Cells(3, 3): Arr(10) = .Cells(3, 7): Arr(11) = .Cells(5, 6): Arr(12) = .Cells(5, 8)
End With
For Each Shp In Sheet1.Shapes
If Shp.Type <> 12 Then Shp.Copy
Next Shp
With Sheet2
Rc = .Cells(Rows.Count, 2).End(xlUp).Row
If Rc < 3 Then
.Cells(3, 1) = 1
.Cells(3, 2).Resize(1, 12) = Arr
.ChartObjects.Add(.Range("G3").Left, .Range("G3").Top, .Range("G3").Width, .Range("G3").Height).Chart.Paste
Else
For K = 3 To Rc
Dic(.Cells(K, 6).Text) = K
Next K
If Dic.Exists(Arr(5)) Then
.Cells(Dic(Arr(5)), 2).Resize(1, 12) = Arr
Else
.Cells(Rc + 1, 1) = "=Counta($B$3:B" & Rc + 1 & ")"
.Cells(Rc + 1, 2).Resize(1, 12) = Arr
.ChartObjects.Add(.Cells(Rc + 1, 7).Left, .Cells(Rc + 1, 7).Top, .Cells(Rc + 1, 7).Width, .Cells(Rc + 1, 7).Height).Chart.Paste
End If
End If
End With
End Sub
Sub 删除图片()
Dim Shp As Shape
For Each Shp In ActiveSheet.Shapes
If Shp.Type <> 12 Then Shp.Delete
Next Shp
End Sub
|
最佳答案
查看完整内容
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim Rg As Range
Set Rg = Range("H2:H4")
If Target.Address = "$C$5" Or Target.Address = "$C$2" Then
删除图片
ActiveSheet.Shapes.AddShape(msoShapeRectangle, Rg.Left, Rg.Top, Rg.Width, Rg.Height).Select
Selection.ShapeRange.Fill.UserPicture ThisWorkbook.Path & "\图片\" & Cells(2, 3) & Cells(5, 3) & ".j ...
|