求助：把*号内的文字提取到新的一列。没*号直接空白。

表哥佩奇

不用VB啊   用函数就能解决

表哥佩奇

如果你需要效果列名字前后带星号的话，公式数字改下就行了

zldccmx

Sub zldccmx()
    arr = Sheet1.UsedRange.Columns(1)
    For i = 1 To UBound(arr)
        If InStr(arr(i, 1), Chr(10)) Then
            arr(i, 1) = Split(arr(i, 1), Chr(10))(0)
            If Left(arr(i, 1), 1) <> "*" Then arr(i, 1) = ""
        Else
            arr(i, 1) = ""
        End If
    Next
    [c1].Resize(UBound(arr), 1) = arr
End Sub

zldccmx

demonimissyou

Sub xx()
Dim i, j, k, l, reg, arr
Set reg = CreateObject("VBScript.regexp")
reg.Pattern = "\*\W+\*"
reg.Global = True
i = [A65536].End(xlUp).Row
arr = Range("a1:a" & i)
ReDim brr(1 To UBound(arr), 1 To 1)
For j = 1 To UBound(arr)
Set k = reg.Execute(arr(j, 1))
For l = 0 To k.Count - 1
brr(j, 1) = k(l)
Next
Next
[B1].Resize(UBound(arr), 1) = brr

End Sub