楼主 little-key |
这个是基于andysky的选择性粘贴工具开发的,再此表示感谢,只是补充了一些固定的选项,并结合字典的快速特点开发,界面设计我就不提供了,目前先提供代码,有需要界面的,请直接联系我,目前我只贴界面的截图。- Private Sub UserForm_Initialize()
- Dim arr
- ComboBox1.BackColor = RGB(255, 255, 225) '设置文本框颜色
- Me.ComboBox1.Clear
- arr = [{",","/","#","$","@"}]
- Me.ComboBox1.List = arr
- Me.ComboBox1.Text = ","
- End Sub
- Private Sub CommandButton1_Click()
- Dim ans As Byte, texts As New DataObject, n As Long, i As Long, arr, t As Single
- If ActiveSheet.ProtectContents Then MsgBox "工作表已保护,本程序拒绝执行!", 64, "提示": Exit Sub
- On Error Resume Next
- Application.Calculation = xlCalculationManual '设置工作簿手动计算
- Application.EnableEvents = False '指定对象禁用事件
- arr = Selection
- n = UBound(arr)
- With CreateObject("scripting.dictionary") '建立字典
- If OptionButton2.Value = True Then '在后面添加
- For i = 1 To UBound(arr)
- .add i, arr(i, 1) & VBA.Replace(ComboBox1.Text, Chr(10), "") '顺序建立字典内容
- Next
- Else '在前面添加
- For i = 1 To UBound(arr)
- .add i, VBA.Replace(ComboBox1.Text, Chr(10), "") & arr(i, 1) '顺序建立字典内容
- Next
- End If '添加结束
- arr = Selection
- For i = 1 To UBound(arr)
- arr(i, 1) = .item(i) '在字典中按key取item
- Next
- End With
- Selection = arr
- Application.EnableEvents = True '指定对象启用事件
- Application.Calculation = xlCalculationAutomatic '工作簿自动计算
- ' Application.ScreenUpdating = True
- MsgBox "Excel 已经完成搜索并进行了 " & n & " 处添加。", vbInformation + vbOKOnly, "完成信息"
- Unload Me
- End Sub
- Private Sub CommandButton2_Click()
- Unload Me
- End Sub
- Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
- On Error Resume Next
- If KeyCode = 27 Then Unload Me
- End Sub
Snap2.jpg |