我有一种情况，我需要解析包含多行文本EXAMPLE SHEET的单元格数据和预期的期望结果。我相信我们可以通过使用regx来创建这样的解析，但是我太愚蠢了，无法弄清楚我的代码有什么问题。
$update = json_decode(file_get_contents('php://input'));
$callback_query = $update['callback_query'];
if (isset($callback_query)){
//Fetching callback
$data = $callback_query->data;
$message = $callback_query->message;
$message_id = $callback_query->message->message_id;
$chat_id = $message->chat->id;
switch($data){
case "1":
bot('SendMessage',[
'chat_id' => $chat_id,
'text' => "1"
]);
break;
case "2":
bot('SendMessage',[
'chat_id' => $chat_id,
'text' => "2"
]);
break;
}
}else{
$message = $update->message;
$message_id = $update->message->message_id;
$text = $message->text;
$chat_id = $message->chat->id;
//Statement beginning
switch($text){
case "/select":
$keyboard = array(
'keyboard' => [[['text' => "one", 'callback_data' => "1"]],[['text' => "two", 'callback_data' => "2"]]],
'resize_keyboard' => true,
'one_time_keyboard' => true
);
$markup = json_encode($keyboard, true);
bot('SendMessage',[
'chat_id' => $chat_id,
'reply_markup' => $markup,
'text' => "Choose your option"
]);
break;
default:
bot('SendMessage',[
'chat_id' => $chat_id,
'text' => "This is a test"
]);
}
}
我想要实现的是从单元格解析数据，然后是关键短语STUDENT NAME和ART
在它的顶部我有一些日期，可能只有一个或多个日期在关键线＆＃39;非最终结果＆＃39;之后。如果事件日期出现在需要在相应列中给出的该短语之后，如果其倍数则需要将它们堆叠在相同的列单元格中。
更新日期解释的问题
Sub AddDetails(c As Range)
Dim x As Variant
Dim y As Variant
Dim a() As Variant
Dim r As Long
Dim i As Long
Dim j As Long
ActiveSheet.Cells(1, col + 1).Value = "Student Name"
ActiveSheet.Cells(1, col + 2).Value = "ART"
ActiveSheet.Cells(1, col + 3).Value = "Non-Final Result"
ActiveSheet.Cells(1, col + 4).Value = "Final Result"
For r = 2 To Cells(rowS.Count, 1).End(xlUp).Row
y = "Student Name=" & SplitMe(Range(col & r).Value, "Student Name")(1)
x = Split(y, vbLf)
For i = LBound(x) To UBound(x)
If InStr(x(i), "=") Then
ReDim Preserve a(j)
a(UBound(a)) = Split(x(i), "=")(1)
j = j + 1
End If
Next i
Range("C" & r).Resize(, UBound(a) + 1).Value = a
Erase x: Erase a: j = 0
Next r
End Sub
Function FindColumn(searchFor As String) As Integer
Dim i As Integer
'Search row 1 for searchFor
FindColumn = 0
For i = 1 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
If ActiveSheet.Cells(1, i).Value = searchFor Then
FindColumn = i
Exit For
End If
Next i
End Function
Function SplitMe(s As String, delimiter As String)
Dim arr, i As Long
If Len(s) = 0 Or Len(delimiter) = 0 Then
SplitByLastOccurrence = CVErr(2001)
Else
i = InStrRev(s, delimiter)
If i = 0 Then
SplitByLastOccurrence = Array(s)
Else
ReDim arr(0 To 1)
arr(0) = Trim(Left$(s, i - 1))
arr(1) = Trim(Mid$(s, i + Len(delimiter) + 1))
SplitByLastOccurrence = arr
End If
End If
End Function
答案 0 :(得分：2)
这是使用正则表达式提取每个数据部分的一种方法。它会再现样本表中的内容
编辑：代码已经过编辑，以说明确定Final和non-Final结果日期以及RCE的不同方法。
EDIT2 ：根据海报的要求编辑某些条款
我使用相同的逻辑来确定Name和ART（除了将学生姓名更改为xxxxx。
我用来返回日期的逻辑是：
Event Publication Date= Final Result，Non-Final Result，xxxxx），中间有否日期。Option Explicit
'set reference to Microsoft Scripting Runtime
' Microsoft VBScript Regular Expressions 5.5
Private RE As RegExp
Private MC As MatchCollection
Sub StudentDetail()
Dim dS As Dictionary
Dim WS As Worksheet
Dim vSrc As Variant, vRes As Variant, rRes As Range
Dim V As Variant, I As Long, J As Long
Dim S As String
'Read data into vSrc
Set WS = Worksheets("sheet1")
With WS
vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
'First cell of results array
Set rRes = WS.Cells(1, 2)
'Initialize Regex
Set RE = New RegExp
With RE
.Global = True
.MultiLine = True
.IgnoreCase = True
End With
'Collect the data into a dictionary
Set dS = New Dictionary
dS.CompareMode = TextCompare
For I = 2 To UBound(vSrc, 1)
ReDim V(4)
S = vSrc(I, 1)
'Name
V(0) = reExtract(S, "Primary xxxxx:\s+(.*)")
'ART
V(1) = reExtract(S, "ART=(.*)")
'NonFinal
V(2) = reExtract(S, "Event publication date=(\d{4}-\d{2}-\d{2})(?:(?!\d{4}-\d{2}-\d{2})[\s\S])*Non-Final")
'Final
V(3) = reExtract(S, "Event publication date=(\d{4}-\d{2}-\d{2})(?:(?!\d{4}-\d{2}-\d{2})[\s\S])*^Final Rejection")
'RCE
V(4) = reExtract(S, "Event publication date=(\d{4}-\d{2}-\d{2})(?:(?!\d{4}-\d{2}-\d{2})[\s\S])*xxxxxx")
If Not dS.Exists(V(0)) Then
dS.Add Key:=V(0), Item:=V
Else
MsgBox "duplicate name"
Stop 'You need to decide what to do
End If
Next I
'Output the results to array
ReDim vRes(0 To dS.Count, 1 To 5)
vRes(0, 1) = "xxxxx"
vRes(0, 2) = "ART"
vRes(0, 3) = "Non-Final Result"
vRes(0, 4) = "Final Result"
vRes(0, 5) = "RCE"
For I = 0 To dS.Count - 1
V = dS(dS.Keys(I))
For J = 0 To 4
If IsArray(V(J)) Then
vRes(I + 1, J + 1) = Join(V(J), vbLf)
Else
vRes(I + 1, J + 1) = V(J)
End If
Next J
Next I
'write array to worksheet
Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2))
With rRes
.EntireColumn.Clear
.Value = vRes
With .Rows(1)
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
.EntireColumn.AutoFit
End With
End Sub
Function reExtract(S As String, sPat As String)
Dim V As Variant
Dim I As Long
With RE
.Pattern = sPat
If .Test(S) = True Then
Set MC = .Execute(S)
With MC
If .Count = 1 Then
reExtract = MC(0).SubMatches(0)
Else
ReDim V(0 To .Count - 1)
I = 0
For I = 0 To .Count - 1
V(I) = MC(I).SubMatches(0)
Next I
reExtract = V
End If
End With
End If
End With
End Function
答案 1 :(得分：1)
嗯，RegEx VBA无效的关键部分可能是您没有包含任何与RegEx相关的代码。 :)但是我看到你试图将一些代码片段放在一个工作示例中，这样你就可以获得积分！
查看您的数据示例我不得不想知道大图片是什么，例如，这些数据的来源，以及是否有更好的方法来解析它而不是手动使用VBA。例如，如果这是从数据库或网站链接或导入的代码，可能是大量的，也许Excel内置的“Get External Data”功能更适合，或者您应该倾向于使用Access。
尽管如此，我很好奇解析你的规范需要什么，我总结了一个有效的解决方案，至少在你提供的单个例子中（没有RegEx）。您的示例的更新副本为uploaded here（虽然我不确定它是否会正确下载，或者VBA是blocked）。
Option Explicit
'These functions can be used two ways:
' 1. Call sub [populateStudentData] and then programmatically put the extracted data where it needs to go (like sub "sTest" does below)
' 2. Call function [studentData] in a worksheet cell to return the desired field
' - Syntax: =studentData ( rawData_In, fieldName_Out )
' - example: =studentData ( A2, "Final Result" ) : returns all the "Final Result" dates found in cell A2
' * NOTE that WRAP TEXT in "Cell Format > Alignment" must be on for multi lines (via vbLf) to display properly with this method
' WRAP TEXT can also be set programmatically with cell.WrapText (see: https://stackoverflow.com/a/9902628/8112776)
' - less efficient since it parses all the data for each cell & each field, on every calculation,
' but shouldn't be a problem unless the function is used in a LOT of cells (in which case it start getting slow to re-calculate)
'Slapped together by ashleedawg@outlook.com for 'SO' Question: https://stackoverflow.com/questions/46996095/parsing-excel-single-cell-data-based-on-condition
'This code contain *zero error checking* and limited documentation. Google any terms with which you are unfamiliar.
'Created with limited information on the actual application, this is FAR-from the most efficient way to parse data! "Provided for educational purposes only!"
'Perhaps using Collections or Objects would be more efficient. Please feel free to improve & re-post this code, comments, suggestions, etc.
'declare an array to temporarily store:
' "sField" = text before the delimiter, in: "arrStudentData(__,0)"
' "sValue" = text after the delimiter (if there is one), in: "arrStudentData(__,1)" (Multiple values will be concatenated, delimited with vbLf's)
' "sDelimiter" = character that separates the sField from the SValue: either a Colon or an Equal Sign (: or =)
Public arrStudentData(1 To 99, 0 To 1) As String
Public Function studentData(rawData_In As String, fieldName_Out As String) As String
'parse [rawData_In] and return concatenated string of "sValue" data for "sField" specified in [fieldName_out]
'the concatenated output of the function can be SPLIT (or values Text-To-Column'd) based on [newDelimiter] (vbLf by default]
'call this function on a workdheet or programmatically
populateStudentData (rawData_In)
studentData = getField(fieldName_Out)
End Function
Sub sTest()
'as a test/debugging, let's parse data from cell A2
populateStudentData (Range("$A$2").Value)
Stop 'hit F5 or click "play" to print results to the Immediate Window (Hit CTRL+G here to view)
Call print_Results
Stop 'hit F5 or click "play" to print data for field "Final Result" to Immediate Window
Debug.Print getField("Final Result")
Stop 'hit F5 or click "play" to populate cell A3 with data for field "Final Result"
Range("$A$3") = getField("Final Result")
End Sub
Sub populateStudentData(str_Input As String)
'populate array [arrStudentData] by parsing [str_Input] (the raw string we need to decode)
Dim new_Delimiter
new_Delimiter = Chr(10)
Dim arr_Input() As String '[str_Input] split into an array & cleaned up
Dim sFieldCount As Integer 'the number of "sField"'s found in [str_Input]
Dim sLineNumber As Integer 'the input "line" we are processor (counter)
Dim sFieldExists As Boolean 'TRUE if the "sField" has already been found at least once
Dim x As Integer 'counter
'start with an empty array
Erase arrStudentData
'remove "Event Date" to combine date with previous line for {"Final Result" or "Non-Final Result"}
str_Input = Replace(str_Input, "Result" & vbLf & "Event Date", "Result", , , vbTextCompare) '(vbTextCompare makes the search non-case-sensitive)
'split [str_Input] into array [arr_Input] with vbLf's separating each value
arr_Input = Split(str_Input, vbLf)
'enumerate [arr_Input] to create a list of "sField's" in arrStudentData(x, 0)
sFieldCount = 0
For sLineNumber = 0 To UBound(arr_Input)
If extract_sValue(arr_Input(sLineNumber)) <> "" Then 'ignore lines that don't have an "sValue"
'does this field already exist?
sFieldExists = False
'enumerate [arrStudentData(x, 0)] to see if this field already exists
For x = 1 To sFieldCount
If arrStudentData(x, 0) = extract_sField(arr_Input(sLineNumber)) Then sFieldExists = True 'field already exists in list
Next x
If Not sFieldExists Then 'field doesn't exist, add it to list
sFieldCount = sFieldCount + 1
arrStudentData(sFieldCount, 0) = extract_sField(arr_Input(sLineNumber))
End If
End If
Next sLineNumber
'we now have an array of field names : arrStudentData(1 to [sFieldCount],0)
'next, enumerate [arr_Input] again, this time putting the "sValue's" into arrStudentData(x, 1)
For sLineNumber = 0 To UBound(arr_Input)
For x = 1 To sFieldCount
'add the VALUE to the arrStudentData(x, 1)
If extract_sField(arr_Input(sLineNumber)) = arrStudentData(x, 0) Then
'this field is arrStudentData(x, 0) so concatenate the value after the "sDelimiter" to arrStudentData(x, 1)
If Len(arrStudentData(x, 1)) > 0 Then
'this isn't the first value so add [new_Delimiter] before "sValue" (default: vbLf)
arrStudentData(x, 1) = arrStudentData(x, 1) & new_Delimiter
End If
arrStudentData(x, 1) = arrStudentData(x, 1) & extract_sValue(arr_Input(sLineNumber))
End If
Next x
Next sLineNumber
End Sub
Function getField(sField As String) As String
'return "sValue" for the specified "sField"
Dim x As Integer 'counter
'enumerate the array to find a match
For x = LBound(arrStudentData) To UBound(arrStudentData)
If LCase(arrStudentData(x, 0)) = LCase(sField) Then 'compare lowercase (so not case sensitive)
'found a match
getField = arrStudentData(x, 1)
Exit Function
End If
Next x
End Function
Function extract_sField(str_In As String) As String
'return text found BEFORE one of the "sDelimiter's"
If str_In <> "" Then extract_sField = Split(Split(str_In, ":")(0), "=")(0)
End Function
Function extract_sValue(str_In As String) As String
'return text found AFTER one of the "sDelimiter's"
If InStr(str_In, "=") > 0 Then
extract_sValue = Trim(Split(str_In, "=")(1)) 'text after "sDelimiter" =
Else
If InStr(str_In, ":") > 0 Then
extract_sValue = Trim(Split(str_In, ":")(1)) 'text after "sDelimiter" :
Else
extract_sValue = "" 'no "sDelimiter's" found so return no value
End If
End If
End Function
Sub print_Results()
'for testing/debugging purposes: print values of array [arrStudentData] in the Immediate Window (Hit CTRL+G here to view)
Dim x As Integer 'counter
Debug.Print "----------"
For x = LBound(arrStudentData) To UBound(arrStudentData)
If arrStudentData(x, 0) <> "" Then
Debug.Print "arrStudentData(" & x & ",0) = """ & arrStudentData(x, 0) & """"
Debug.Print "arrStudentData(" & x & ",1) = """ & arrStudentData(x, 1) & """"
Debug.Print "----------"
End If
Next x
End Sub
正如你可能知道的那样，SO不应该是一个“代码编写服务”，但我把它作为一种练习“挑战”，看看我是否可以一起拍打某些东西（所以不要给我废话，mods！）没有错误处理和有限的评论，但看看，也许你可以根据需要调整它。有绝对更有效的解决方法，而不是反复为每个单元格反复枚举相同数组的方法，因此它不适合“巨大”规模... < / p>