VBA 修改提示

a3712449

Option Explicit

Sub test()

Dim arr
Dim brr
Dim crr()
Dim m_text As String, i As Integer, j As Integer, m As Variant, k As Integer
arr = Sheet1.[a1].CurrentRegion

m_text = InputBox("请输入关键词，多个关键词中间用“，”间隔！", "关键字输入")
If m_text = "" Then Exit Sub

brr = Split(m_text, "，")

For Each m In brr
k = 0
    For j = 1 To UBound(arr)
        If m = arr(j, 9) Then
        k = k + 1
        i = i + 1
        ReDim Preserve crr(1 To 2, 1 To i)
        crr(1, i) = "'" + arr(j, 1)
        crr(2, i) = arr(j, 9)

        End If
    Next j
    If k = 0 Then
    MsgBox "关键词“" & m & "”不存在，请重新输入", , "错误提示"
    Exit Sub
    End If
Next
Range("q:r").Clear

[q1].Resize(UBound(crr, 2), 2) = Application.WorksheetFunction.Transpose(crr)

End Sub
修改成忽略错误继续下一个

砂海

行号: '行号 以 ":" 结束
-------------------------------------------------------
on error resume nent '跳过错误 , 执行 下一句

on error goto 行号 '出现错误 , 跳转指定行号

on error goto 0 '取消错误跳转

a3712449

砂海 发表于 2021-6-27 08:22
行号: '行号 以 ":" 结束
-------------------------------------------------------
on error resume ne ...

老师，能帮我写一下吗？