如何提取批注中特定的内容到指定的单元格!~

发布网友发布时间：2022-05-07 16:25

共3个回答

热心网友时间：2022-06-30 16:58

我的理解：邮箱地址只会出现在批注的5、6、7行，是这样吗？
如果是，把没用的数据全部删了，然后运行下面的代码测试。
Option Explicit
Sub tiqu()
Dim rw As Long
Dim i As Long
Dim arr, brr(1 To 10000, 1 To 4)
rw = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To rw
arr = Split(Cells(rw, 2).Comment.Text, Chr(10))
brr(i - 1, 1) = Mid(arr(1), 4)
brr(i - 1, 2) = arr(2)
brr(i - 1, 3) = arr(3)
If arr(4) Like "*@*" Then
brr(i - 1, 4) = arr(4)
ElseIf arr(5) Like "*@*" Then
brr(i - 1, 4) = arr(5)
ElseIf arr(6) Like "*@*" Then
brr(i - 1, 4) = arr(6)
End If
Next i
Cells(2, 3).Resize(Rows.Count - 1, 4).ClearContents
Cells(2, 3).Resize(rw - 1, 4) = brr
End Sub

热心网友时间：2022-06-30 16:58

Sub 批注内容()
For i = 1 To ActiveSheet.Comments.Count
a = ActiveSheet.Comments(i).Text '批注内容
b = InStr(1, a, "：") '字符位置
ActiveSheet.Comments(i).Parent.Next.Value = Mid(a, b + 1, 10)
Next
End Sub
或者输代码
Option Explicit
Sub tiqu()
Dim rw As Long
Dim i As Long
Dim arr, brr(1 To 10000, 1 To 4)
rw = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To rw
arr = Split(Cells(rw, 2).Comment.Text, Chr(10))
brr(i - 1, 1) = Mid(arr(1), 4)
brr(i - 1, 2) = arr(2)
brr(i - 1, 3) = arr(3)
If arr(4) Like "*@*" Then
brr(i - 1, 4) = arr(4)
ElseIf arr(5) Like "*@*" Then
brr(i - 1, 4) = arr(5)
ElseIf arr(6) Like "*@*" Then
brr(i - 1, 4) = arr(6)
End If
Next i
Cells(2, 3).Resize(Rows.Count - 1, 4).ClearContents
Cells(2, 3).Resize(rw - 1, 4) = brr
End Sub

热心网友时间：2022-06-30 16:59