如何使用正则表达式拆分多个大写字母/定界符/文本？ （VBA）

Question

我有2k条以上的记录带有字符串followyng规则（位置I大写-文本）x多次，如下所示：

I- TRZON - Fragmenty błony śluzowej trzonu żołądka w stanie przewleklego 
powierzchownego (++) aktywnego (++) zapalenia. W barwieniu Warthin-Starry 
nie stwierdza się bakterii odpowiadających Helicobacter pylori. II-ANTRUM + 
KĄT - Fragmenty błony śluzowej części odźwiernikowej żołądka w stanie 
przewlekłego głębokiego zapalenia (+++). W barwieniu Warthin-Starry nie 
stwierdza się bakterii odpowiadajacych Helicobacter pylori.

我正尝试使用正则表达式拆分如下：

Location - I- TRZON
Text Fragmenty błony śluzowej trzonu żołądka w stanie przewleklego powierzchownego (++) aktywnego (++) zapalenia. W barwieniu Warthin-Starry nie stwierdza się bakterii odpowiadających Helicobacter pylori.
Location II- ANTRUM + KĄT
Text Fragmenty błony śluzowej części odźwiernikowej żołądka w stanie przewlekłego głębokiego zapalenia (+++). W barwieniu Warthin-Starry nie stwierdza się bakterii odpowiadajacych Helicobacter pylori.

到目前为止，我设法通过创建类似这样的内容来实现

([A-ZŻŹĆĄŚĘŁÓŃ\s,+\-0-9]*)[\s]?-+?(.*[^A-ZŻŹĆĄŚĘŁÓŃ\s,+\-0-9]) ([A-ZŻŹĆĄŚĘŁÓŃ\s,+\-0-9]+)*[\s]?-+?(.*)

但是显然，它不能管理那些可能存在一对或三对位置和文本的字符串。我遇到的主要问题是文本中使用连字符（请参阅-Warthin-Starry）。

如果我尝试一些更优雅的东西，例如

([A-ZŻŹĆŃĄŚŁĘÓ]+[\s-\+,]*?)-(.*)

显然，它仅将第一个连字符前面的单词与第一组匹配，而将其他所有单词与下一个匹配。

总结：如何将正则表达式翻译为：匹配，分为两组：1）大写字母带有其他符号（无小写字母），其次是2）文本，只要遇到另一个大写字母文字。

我必须承认我对regex还是很陌生，但是我搜索了几天，却似乎没有一个能正常工作的方法（这只是从此字符串中提取数据的开始...）

Answer 1

我不确定如何使用RegEx做到这一点，我自己很难理解该语法。

但是，我可能只使用DATA / Text To Columns（数据/文本到列），用连字符分隔，然后将由文本中的连字符引起的多余分隔重新串联在一起。

如果不只是一次性处理，还可以始终使用VBA，例如：

Sub TextToColumns()
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim lRow As Long, sndHyphen As Long, R As Long

    lRow = ws.Cells(1, 1).End(xlDown).Row

    For R = 1 To lRow                                                               'Iterate through all rows containing this data
        sndHyphen = InStr(InStr(ws.Cells(R, 1), "-") + 1, ws.Cells(R, 1), "-")      'Get the hyphens positions
        ws.Cells(R, 2) = Left(ws.Cells(R, 1), sndHyphen - 2)                        'Get the data before the second hyphen
        ws.Cells(R, 3) = Mid(ws.Cells(R, 1), sndHyphen + 2)                         'Get the data after the second hyphen
    Next R

End Sub

Answer 2

感谢您的输入。我终于设法通过两个子实现了这一点：

Sub locfinder()

Dim myregexp As RegExp
Set myregexp = New RegExp
Dim myMatches As Variant
Dim myMatch As Variant
Dim str As String
Dim i, j As Integer
Dim endrow As Integer
Sheets("dane").Activate
endrow = LastRow
Dim rozp1, rozp2 As String

For i = 1 To endrow
str = Sheets("Dane").Cells(i, 10).Value
myregexp.Global = True
myregexp.Pattern = "([A-ZŻŹĆĄŚĘŁÓŃ]+[\s,+\-0-9]*[A-ZŻŹĆĄŚĘŁÓŃ]*[\s,+\-0-9]*[A-ZŻŹĆĄŚĘŁÓŃ]*[\s,+\-0-9]*|Trzon|Antrum)\s?-"

If Not str = "" Then
Set myMatches = myregexp.Execute(str)
 j = 1
 For Each myMatch In myMatches
    If myMatch.Value <> "" Then
    Sheets("Dane").Cells(i, j + 10).Value = Trim(myMatch.SubMatches(0))
    j = j + 1
    End If
Next
End If
Next i
End Sub

然后使用提取诊断信息

Sub rozpfinder()
Dim myregexp As RegExp
Set myregexp = New RegExp

Dim myMatches As Variant
Dim myMatch As Variant
Dim str As String
Dim i, j As Integer
Dim endrow As Integer
Sheets("dane").Activate
endrow = LastRow
Dim rozp, loc As Collection
Dim splitted() As String
Dim rozpoznanie, lokalizacja
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Dane")

For i = 1 To endrow
    str = ws.Cells(i, 10).Value
    Set loc = New Collection
    Set rozp = New Collection

    For j = 1 To 2
        If ws.Cells(i, 10 + j) <> "" Then
            loc.Add ws.Cells(i, 10 + j).Value
        End If
    Next j
    For Each lokalizacja In loc
        If lokalizacja <> "I" Then
        str = Replace(str, lokalizacja, "xxx")
        Else
        lokalizacja = "I-"
        str = Replace(str, lokalizacja, "xxx-")
        End If
    Next lokalizacja
    splitted = split(str, "xxx")
    For j = 0 To UBound(splitted)
        If splitted(j) <> "" Then
        myregexp.Pattern = "-[^\w]"
        myMatch = myregexp.Replace(splitted(j), "")
        rozp.Add (Trim(myMatch))
        End If
    Next j
    j = 1
    For Each rozpoznanie In rozp
        ws.Cells(i, 12 + j).Value = rozpoznanie
        j = j + 1
    Next rozpoznanie
Next i
End Sub

虽然不是100％准确，但我需要更正的记录数约为1％，所以我想它是可行的：）