VBA在单元格中查找字符串并复制到其他单元格

我有数据表明它在单元格中的位置不一致，有时它有一个分号，有时它在分号的右边或左边。我想要的最终结果是在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)

我仍然需要手动查找和替换，删除括号和文本，只留下学生/老师的名字

是否有任何VBA宏可以帮助我从A列获得B列和C列中的预期结果？多谢各位

---

您可以使用正则表达式来实现这一点。有关如何在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

---

宏将字符串拆分为分号，并在“arr”数组中存储1或2个子字符串。然后，它对每个对象执行正则表达式。如果括号内的字符串是“教师”，则前面的人的姓名存储在“C”列中，否则它是学生，姓名存储在“B”列中。

我创建了一个按钮，用于读取a列上的所有寄存器 然后把学生放在B栏 然后把老师放在C栏

检查我是否使用“（Teacher）”来知道教师何时在字符串中 我用了一张叫做“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

---

是的，就是你写的那个。这不是一个代码编写服务。努力自己写一篇，如果遇到问题，问一个问题。三个是关于VBA中单元格循环的几十个（如果不是几百个）现有问题，您可以使用这些问题开始。我知道我不应该在评论中说谢谢，但这很好。我并不期待解决方案，但这完美地解决了我的问题。很高兴看到仍然有人愿意帮助他人，并为他人付出更多的努力。我总是尽量在我能做的地方做。再次感谢。