在整列的特定前一个文本字符串之后提取引号中的文本

Question

我有一列数据，需要删除公司名称两侧的文本，只在该列中保留公司名称
公司名称总是以"开头；Company"值"：

单元格数据示例：
一些要删除的文本，："Company"值"：">公司名称保留"；，要删除的一些文本

请帮助我使用Excel VBA来完成此操作。我不知道从哪里开始

谢谢。

Answer 1

我自己设法解决了这个问题
我把这个过程分成了不同的阶段
首先，我发现从数据列中删除所有引号、逗号和冒号更容易
然后使用InStr查找Companyvalue并删除它之前的所有内容，包括Companyvalue文本本身，然后使用类似的过程删除我想要保留的"公司名称"文本之后的所有文本。

单元格数据字符串示例：

{"profile":{"45":{"B":{"profile_id":"2829","description":"Company","value":"Company Name Text To Keep","section":"B","field_id":"45"}}}}

我使用的VBA：

Sub ExtractCompanyName()
Application.ScreenUpdating = False
ActiveSheet.Range("B:B").Replace What:="""", Replacement:="", LookAt:=xlPart, MatchCase:=False
ActiveSheet.Range("B:B").Replace What:=",", Replacement:="", LookAt:=xlPart, MatchCase:=False
ActiveSheet.Range("B:B").Replace What:=":", Replacement:="", LookAt:=xlPart, MatchCase:=False
ActiveSheet.Range("B:B").Replace What:="_", Replacement:="", LookAt:=xlPart, MatchCase:=False
Application.ScreenUpdating = True
For Each Cell In Sheets(1).Range("B:B")
If InStr(Cell.Value, "Companyvalue") > 0 Then Cell.Value = Split(Cell.Value, "Companyvalue")(1)
Next
For Each Cell In Sheets(1).Range("B:B")
If InStr(Cell.Value, "sectionBfieldid45") > 0 Then Cell.Value = Left(Cell.Value, InStr(Cell.Value, "sectionBfieldid45") - 1)
Next
End Sub

我希望这能帮助其他人。

Answer 2

假设JSON格式是固定的，并且您只需要其中的1个值，下面的解决方案使用Regex:

Option Explicit
Private Sub ExtractCompanyName()
Const regexPattern As String = """value"":""([sS]{1,})"",""section"""

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(1) 'Change to correct worksheet reference

'Get last row in column B
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

'Get the value into an array for faster processing, process cell by cell is a very slow process in general and should be avoided where possible.
Dim processRng As Range
Set processRng = ws.Range("B1:B" & lastRow)

Dim processArr As Variant
processArr = processRng.Value

'Create Regex and parse each value in the array to extract the company name
Dim regex As Object
Set regex = CreateObject("vbScript.Regexp")
regex.Pattern = regexPattern

Dim i As Long
For i = 1 To UBound(processArr, 1)
If regex.Test(processArr(i, 1)) Then
processArr(i, 1) = regex.Execute(processArr(i, 1))(0).SubMatches(0)
End If
Next i
Set regex = Nothing

'Write the array back into worksheet
processRng = processArr

Set processRng = Nothing
Set ws = Nothing
End Sub