根据格式在Excel单元格中分隔文本

Question

我想根据单元格中内容的格式将一个单元格中的文本拆分为2个单元格。在下图中：我想将蓝色文本与电子邮件地址分开。任何人都可以提出一个excel公式或解决方法吗？

Answer 1

我发现了一种有效的方法，但是我不知道你的字体颜色代码，所以在我的例子中我使用的是红色。您需要弄清楚单元格中的字体颜色。

使用MsgBox ActiveCell.Characters(Start:=1, Length:=1).Font.Color获取ActiveCell中第一个字符的代码。

它的工作方式是一次检查字符串1中的每个字符。如果字符为红色，则会向c变量添加一个数字。最后，我选择了左c个字符。

Sub test1()

Dim i As Integer
Dim c As Integer
Dim l As Integer


While ActiveCell.Value <> ""

i = 1
c = 0
l = Len(ActiveCell.Value)

While i <= l

If ActiveCell.Characters(Start:=1, Length:=i).Font.Color = 255 Then
c = c + 1
i = i + 1

Else

i = i + 1

End If

Wend

ActiveCell.Offset(0, 1).Value = Left(ActiveCell.Value, c)
ActiveCell.Offset(0, 2).Value = Right(ActiveCell.Value, l - c)

ActiveCell.Offset(1, 0).Select

Wend

End Sub

结果如下：

Answer 2

1. 按Alt + F11以打开Microsoft Visual Basic for Applications窗口

2. 通过以下代码：

   Function GetBoldString(workCell As Range)  
   strLen = Len(workCell)  
   GetBoldString = ""  
   For i = 1 To strLen  
      If workCell.Characters(i, 1).Font.Bold Then  
          GetBoldString = GetBoldString & workCell.Characters(i, 1).Text  
      End If  
   Next i  
   End Function  
   
   Function GetNoBoldString(workCell As Range)  
   strLen = Len(workCell)  
   GetNoBoldString = ""  
   For i = 1 To strLen  
      If workCell.Characters(i, 1).Font.Bold = False Then  
         GetNoBoldString = GetNoBoldString & workCell.Characters(i, 1).Text  
   End If  
   Next i  
   End Function  
   

3. 返回电子表格 在您想要粗体部分粘贴的单元格中：

   = GetBoldString（A1）

4. 在您想要无粗体部分粘贴的单元格中：

   = GetNoBoldString（A1）

将A1替换为您要拆分的单元格的引用。

处理workCell.Characters（i，1）的属性，您可以按其他格式属性进行拆分，例如颜色。

这是两个VBA函数，用于将任何颜色的字符串部分（不同于黑色）与黑色部分分开。

Function GetColorString(workCell As Range)
strLen = Len(workCell)
GetColorString = ""
For i = 1 To strLen
    If workCell.Characters(i, 1).Font.Color <> vbBlack Then
        GetColorString = GetColorString & workCell.Characters(i, 1).Text
    End If
Next i
End Function

Function GetBlackString(workCell As Range)
strLen = Len(workCell)
GetBlackString = ""
For i = 1 To strLen
    If workCell.Characters(i, 1).Font.Color = vbBlack Then
        GetBlackString = GetBlackString & workCell.Characters(i, 1).Text
End If
Next i
End Function



此致

Answer 3

是否可以用分号作为样本分隔蓝色文本？因为那时你可以拆分包含单元格值的字符串：StrArray = Split(CellXY.Value, ";") strArray是一个字符串数组，它获取两个元素“Arnald，Biarb”和“dfgh.sukusi@drems.com”。然后你只需要说哪个单元格应该得到哪个值。作为示例：CellXY.Value = strArray(0)

Answer 4

由于@TheGuyThat并不了解

我是根据您的vba构建的，现在它可以分离不同的颜色并运行整个专栏。希望对大家有帮助。

Sub SplitCellBasedOnColor()

Dim Cel As Range
For Each Cel In Application.Selection.Cells

i = 1
Group = 1
wholelength = Len(Cel.Value)
GroupOrder = 1
CellOrder = 1

'''loop to separate each group of text within same color
While i < wholelength
If Cel.Characters(Start:=i, Length:=1).Font.Color = _
    Cel.Characters(Start:=i + 1, Length:=1).Font.Color Then
Group = Group + 1
i = i + 1
Else
Cel.Offset(0, CellOrder).NumberFormat = "@"
Cel.Offset(0, CellOrder).Value = Mid(Cel, GroupOrder, Group)
Cel.Offset(0, CellOrder).Font.Color = Cel.Characters(Start:=i, Length:=1).Font.Color
GroupOrder = GroupOrder + Group
Group = 1
i = i + 1
CellOrder = CellOrder + 1
End If
Wend


'''when i = wholelength then run below
Cel.Offset(0, CellOrder).NumberFormat = "@"
Cel.Offset(0, CellOrder).Value = Mid(Cel, GroupOrder, Group)
Cel.Offset(0, CellOrder).Font.Color = Cel.Characters(Start:=i, Length:=1).Font.Color

'''cell in next row
Next Cel

End Sub

结果如下：