数组分割和提取

我试图通过一个单元格中的每个字符来确定一个单词是否加下划线和斜体，但到目前为止循环运行和冻结。 如何复制和移动斜体和下划线的单词？ 这是我迄今为止。 我问了一个新的问题，因为在这个问题上我还不够清楚。 它可以在Array拆分和提取VBA的Excel中访问 。

For Each j In ActiveSheet.Range("C1:C105") v = Trim(j.Value) If Len(v) > 0 Then v = Replace(v, vbLf, " ") Do While InStr(v, " ") > 0 v = Replace(v, " ", " ") Loop arr = Split(v, " ") For Z = LBound(arr) To UBound(arr) e = arr(Z) For i = 1 To Len(v) If j.Characters(i, 1).Font.Italic = True And j.Characters(i, 1).Font.Underline = True Then j.Value.Copy End If Next i Next Z End If Next j​ 

Answer 1

下面的一段代码将Debug.Print所有在下面任何给定单元格中加下划线和格式化斜体的单词：

 Option Explicit Public Sub tmpSO() Dim i As Long Dim j As Range Dim StartPoint As Long Dim InItalicUnderlinedWord As Boolean For Each j In ThisWorkbook.Worksheets(1).Range("C1:C105") If Len(j.Value2) > 0 Then For i = 1 To Len(j.Value2) If j.Characters(i, 1).Font.Italic And j.Characters(i, 1).Font.Underline Then If InItalicUnderlinedWord = False Then StartPoint = i InItalicUnderlinedWord = True End If Else If InItalicUnderlinedWord = True Then Debug.Print Mid(j.Value2, StartPoint, i - StartPoint) InItalicUnderlinedWord = False End If End If If InItalicUnderlinedWord = True And i = Len(j.Value2) Then Debug.Print Mid(j.Value2, StartPoint, i - StartPoint + 1) InItalicUnderlinedWord = False End If Next i End If Next j End Sub 

Debug.Print将输出italic和underlined单词到VBE的立即窗口。 如果你想在其他地方使用这些单词，那么你必须在两个（！）位置调整代码：

1. 一旦进入以InItalicUnderlinedWord开头的部分，以便在单元格内的任何位置查找
2. 在以If InItalicUnderlinedWord = True And i = Len(j.Value2) Then开头的部分中， If InItalicUnderlinedWord = True And i = Len(j.Value2) Then对于单元格中最后一个字符也以underlined和italic 。

如果您有任何疑问或问题，请告诉我。

Answer 2

像这样的东西，只有1个单元格，所以你需要把它添加到你的循环

 Sub test() Dim r As Range Dim v As Variant Dim i As Integer Dim f As Integer Set r = Range("h2") v = Split(r.Value, Chr(32)) For i = 0 To UBound(v) - 1 f = InStr(1, r, v(i)) ' equiv Application.WorksheetFunction.Search(v(i), r) If r.Characters(f, 1).Font.Italic Then Debug.Print v(i) & " is italic" End If Next i End Sub 

Answer 3

一个稍微简单的实现包括首先复制整个单元格值，然后操作复制的范围。 在循环中调用它，并为其提供两个参数： rngToCopy =正在复制的单元格， rngToPaste目标单元格（限定于特定的工作簿/工作表）：

 For each cl in Range("C1:C105") Call CopyItalicUnderlined(cl, __Some Place Else__) Next 

这是程序

 Sub CopyItalicUnderlined(rngToCopy, rngToPaste) rngToCopy.Copy rngToPaste Dim i For i = Len(rngToCopy.Value2) To 1 Step -1 With rngToPaste.Characters(i, 1) If Not .Font.Italic And Not .Font.Underline Then .Text = vbNullString End If End With Next End Sub