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

【问题标题】：VBA to find string in cell and copy to different cellVBA在单元格中查找字符串并复制到不同的单元格
【发布时间】：2017-04-06 01:38:54
【问题描述】：

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

【问题讨论】：

是的，你写的那个。这不是代码编写服务。努力自己写一个，如果遇到问题，请提出问题。三个字面上是数十个（如果不是数百个）关于在 VBA 中循环单元格的现有问题，您可以使用它们来开始。

标签： vba excel

【解决方案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

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

【讨论】：

我知道我不应该在 cmets 中说谢谢，但这很棒。我没想到解决方案，但这完美地解决了我的问题。很高兴看到仍有人愿意帮助并为他人付出额外的努力。我总是尝试在我能做到的地方去做。再次感谢。

【解决方案2】：

我创建了一个按钮，用于读取 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

【讨论】：