VBA查找单元格中的string并复制到不同的单元格

我有数据表明它在单元格中的位置不一致，有时它有分号，有时候是在分号的右边或左边。 我所看到的最终结果是在B列中包含所有“学生”（由非教师定义）和C列中的所有教师。 如果找不到学生或老师，则相应的单元格应该是空白的。

目前，我正在对列进行文本分隔，然后使用以下公式将学生和老师分开：

=IF(SUMPRODUCT(--ISNUMBER(SEARCH({"Arts and Music","Math and Science"},A2)))>0,B2,C2) =IF(SUMPRODUCT(--ISNUMBER(SEARCH("Teacher",A2)))>0,B2,C2) 

我仍然必须做一个手动的查找和replace删除括号和文本，只留下学生/教师的名字。

是否有任何VBAmacros，可以帮助我从列A到我的预期结果列B和C？ 谢谢。

Answer 1

你可以使用正则expression式来做到这一点。 看看这篇文章 ，了解如何在Excel中启用它们。

 Sub FindStrAndCopy() Dim regEx As New RegExp regEx.Pattern = "\s*(\w+)\s*\((.+)\)" With Sheets(1): Dim arr() As String Dim val As String Dim i As Integer, j As Integer Dim person As String, teachOrSubject As String Dim mat As Object For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row: val = Cells(i, "A").Value arr = Split(val, ";") For j = 0 To UBound(arr): Set mat = regEx.Execute(arr(j)) If mat.Count = 1 Then person = mat(0).SubMatches(0) teachOrSubject = mat(0).SubMatches(1) If teachOrSubject = "Teacher" Then Cells(i, "C").Value = person Else Cells(i, "B").Value = person End If End If Next Next End With End Sub 

macros以分号分割string，并在“arr”数组中存储1或2个子string。 然后在每个expression式上做一个正则expression式。 如果括号内的string是“老师”，那么前面的人的名字存储在“C”列中，否则它是学生，名字存储在列“B”中。

Answer 2

我创build一个button，读取列A上的所有寄存器，然后将学生放在B列，然后将教师放在列C上

检查我是否使用“（老师）”来知道教师是否在string中我使用了名为“Sheet1”的工作表并且因为是标题行而不使用第一行。

如果您有任何问题，请与我联系。

 Private Sub CommandButton1_Click() '---------------------------------Variables----------------------------- Dim total, i, j As Integer '--------------Counting the number of the register in column A---------- ThisWorkbook.Sheets("Sheet1").Range("XDM1").Formula = "=COUNTA(A:A)" total = CInt(ThisWorkbook.Sheets("Sheet1").Range("XDM1").Value) '---------------------Creating arrays to read the rows------------------ Dim rows(0 To 1000) As String Dim columnsA() As String '------------Searching into the rows to find teacher or student--------- For i = 2 To total columnsA = Split(ThisWorkbook.Sheets("Sheet1").Range("A" & i).Value, ";") first = LBound(columnsA) last = UBound(columnsA) lenghtOfArray = last - first MsgBox lenghOfArray For j = 0 To lenghtOfArray If InStr(columnsA(j), "(Teacher)") > 0 Then MsgBox columnsA(j) ThisWorkbook.Sheets("Sheet1").Range("C" & i).Value = columnsA(j) Else ThisWorkbook.Sheets("Sheet1").Range("B" & i).Value = columnsA(j) End If Next j Next i '--------------------------------Finishing------------------------------ End Sub