0 
Sub extractdateincells()
    Dim i As Integer, r As Integer, str As String
    For Each c In Range("a1:a10")
        For i = 1 To Len(c.Value)
            If Mid(c.Value, i, 1) = "(" Then
                Range("b1:b10") = Mid(c.Value, i + 1, 1)
            End If
        Next
    Next
End Sub

我尝试使用上述代码提取数据，但无法获得所需的答案。
如果我在 cell1 和 cell2 中有king(anil434323)hkd3和jejrew(3232213)，那么我需要在下一个单元格中anil434323得到答案。 我需要做什么来修复我的代码？3232213

4

2 回答 2

3

而不是滚动您自己的搜索例程，使用InStrand InStrRev：

Sub extractdateincells()
    Dim i As Integer, r As Integer, str As String
    Dim OpenPos As Long, ClosePos As Long
    For Each c In Range("a1:a10")
        str = c.Value
        OpenPos = InStr(str, "(")
        ClosePos = InStrRev(str, ")")
        If OpenPos > 0 And ClosePos > 0 Then
            c.Value = Mid(str, OpenPos + 1, ClosePos - OpenPos - 1)
        End If
    Next
End Sub
于 2013-09-05T15:25:18.510 回答
2

这必须是宏吗？在单元格 B1 中使用此公式并向下复制：

=TRIM(MID(SUBSTITUTE(A1,")",REPT(" ",99)),FIND("(",A1&"(")+1,99))

如果它必须是一个宏，这应该适合你：

Sub extractdateincells()

    Dim sCell As String

    With Range("A1:A10")
        sCell = .Cells(1).Address(0, 0, , True)
        .Offset(, 1).Formula = "=TRIM(MID(SUBSTITUTE(" & sCell & ","")"",REPT("" "",99)),FIND(""(""," & sCell & "&""("")+1,99))"
        .Offset(, 1).Value = .Offset(, 1).Value
    End With

End Sub
于 2013-09-05T15:29:30.780 回答