VBA在单元格中查找字符串并复制到不同的单元格

Question

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

Answer 1

您可以使用正则表达式执行此操作。请参阅此post，了解如何在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

宏将字符串拆分为分号，并在＆＃39; arr＆＃39;中存储1或2个子字符串。阵列。然后它在每一个上做一个正则表达式。如果括号内的字符串是＆＃34;老师＆＃34;然后将前一个人的姓名存储在＆＃34; C＆＃34;否则它是学生，名称存储在＆＃34; B＆＃34;列中。

Answer 2

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

检查我是否使用了＆＃34;（教师）＆＃34;知道老师在String中的时间 我使用了表格Called＆＃34; Sheet1＆＃34; 我不会使用第一行，因为是标题行。

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

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