无忧启动论坛

 找回密码
 注册
搜索
系统gho:最纯净好用系统下载站投放广告、加入VIP会员,请联系 微信:wuyouceo
查看: 108|回复: 3
打印 上一主题 下一主题

vba获取剪贴板内容按指定符号分列写入excel

[复制链接]
跳转到指定楼层
1#
发表于 2025-9-10 10:51:28 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
本帖最后由 likeyouli 于 2025-9-19 08:29 编辑

Sub 获取剪贴板内容按指定符号分列写入excel()
    Dim arr As Variant, brr(), t(), clipboard As Object, textData As String
    Set clipboard = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' 创建MSForms.DataObject对象
   fuhao = InputBox("请输入要用的分隔符", "hhhhhhh", "|||")
    clipboard.GetFromClipboard     ' 从剪贴板获取文本
    textData = clipboard.GetText
'    textData = Replace(textData, Chr(10), "")
'    textData = Replace(textData, Chr(13), "")
    If textData <> "" Then
' arr = Split(textData, vbCr)  '可分别测试vbcr|vblf|vbcrlf 三个符号,如果得出的arrcount与粘贴到notepad2中的行数不一样,说明有问题
'  arr = Split(textData, vbLf)
  arr = Split(textData, vbCrLf)     ' 将文本按行分割成数组,这里用vbcrlf作为行的分割,可先打开notepad2,如果两种行分隔符,会有提示. 用代码写进txt文件再用notepad2打开的会有提示,直接复制进去的不会有提示.
     arrcount = UBound(arr) - LBound(arr) + 1 '一维数组共有多少个元素
    ' MsgBox arrcount
   '  MsgBox arr(219404)
      ReDim brr(LBound(arr)  To UBound(arr))
   For n = LBound(arr) To UBound(arr)
   brr(n) = Split(arr(n), fuhao)
   DoEvents
   Next n
  ReDim t(1 To UBound(brr) + 1, 1 To 30) '如果剪贴板的内容经分裂后,每列长度不一致,这里的30可为最大的列,更大也没事,写大了没啥影响
  For Z = 0 To UBound(brr) '用z循环t1的第一个括号
   For Each ss In brr(Z)  '这里是重点,也就是数组t1的第一个括号对应的内容我看成一个集合。这里只能用for each,因为不能确定第二个括号的元素数量。
   e = e + 1
  t(Z + 1, e) = ss
   Next ss
   e = 0 '这里的e其实就是为了确定t1第二个括号的元素数量
   DoEvents
Next Z

ActiveSheet.Columns("a:b").NumberFormatLocal = "@"
Range("a1").Resize(UBound(t), UBound(t, 2)) = t
DoEvents

' 去除可能的空行
'        Dim i As Long
'        For i = LBound(arr) To UBound(arr)
'            arr(i) = Trim(arr(i))
'        Next i
'
'        ' 显示数组内容(测试用)
'        Debug.Print "剪贴板内容已存入数组,共 " & UBound(arr) - LBound(arr) + 1 & " 行"
'        For i = LBound(arr) To UBound(arr)
'            If arr(i) <> "" Then
'                Debug.Print "行 " & i & ": " & arr(i)
'            End If
'        Next i
'    Else
'        MsgBox "剪贴板为空或包含非文本内容"
    End If

    Set clipboard = Nothing
End Sub







2#
 楼主| 发表于 2025-9-10 10:52:01 | 只看该作者
占楼






回复

使用道具 举报

3#
发表于 2025-9-10 11:05:34 | 只看该作者
是什么代码?觉得很深奥
回复

使用道具 举报

4#
发表于 2025-9-10 13:46:09 | 只看该作者
学习一下
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|捐助支持|无忧启动 ( 闽ICP备05002490号-1 )

闽公网安备 35020302032614号

GMT+8, 2025-12-14 04:23

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表