本文介绍了数组拆分和提取vba excel的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述 29岁程序员，3月因学历无情被辞！ 我得到了这个代码的帮助，但运行它不会执行它需要做的事情。我试图从第一张表的第C行中提取带有下划线和斜体的单词，并将其移动到秒表。预期的结果是在第二个图像。阵列拆分在这种情况下会有用吗？希望样本数据更加清晰。 Sub proj（） 对于每个cl范围（C1：C5）调用CopyItalicUnderlined（cl，Worksheets（Sheet2）。Range（A1））下一个 End Sub Sub CopyItalicUnderlined（rngToCopy，rngToPaste） rngToCopy.Copy rngToPaste Dim i 对于i = Len（rngToCopy .Value2）到1步-1 用rngToPaste.Characters（i，1）如果没有.Font.Italic而不是.Font.Underline然后 .Text = vbNullString 结束如果结束下一个 结束Sub 解决方案 Split（）可以帮助，但只有在您已经找到并解析斜体字之后， c> Characters（）方法可以在范围对象调用 你可以然后尝试以下代码： Option Explicit Sub proj（） Dim dataRng作为范围，cl作为范围 Dim arr As Variant 设置dataRng =工作表（ItalicSourceSheet）。range（C1：C5）'< - |更改ItalicSourceSheet与您的实际源表单名称与工作表（ItalicOutputSheet）'< - |更改ItalicOutputSheet与您的实际输出表名称对于每个cl在dataRng arr = GetItalics（cl）'< - |使用斜体字获取数组 If IsArray（arr）Then .Cells（.Rows.Count，1）.End（xlUp）.Offset（1）.Resize（UBound（arr）+ 1）= Application.Transpose arr）'< - |如果数组被填充，然后将其写入列A中的输出表第一个空白单元下一个结束 End Sub 函数GetItalics（rng As range ）As Variant Dim strng As String Dim iEnd As Long，iIni As Long，strngLen As Long strngLen = Len（rng.Value2） iIni = 1 尽管iEnd< = strngLen 尽管rng.Characters（iEnd，1）.Font.Italic和rng.Characters（iEnd，1）.Font.Underline 如果iEnd = strngLen然后退出Do iEnd = iEnd + 1 循环如果iEnd> iIni然后strng = strng& Mid（rng.Value2，iIni，iEnd - iIni）& | iEnd = iEnd + 1 iIni = iEnd 循环如果strng<> 然后GetItalics = Split（Left（strng，Len（strng） - 1），|）结束函数 I got help with this code but when it runs it does not execute what it needs to do. I'm trying to extract words that are underlined and italicized from row C of the first sheet and move them to the secondsheet. The expected outcome is in the second image. Would array splitting be of use in this situation? Hopefully the sample data make it more clear.Sub proj()For Each cl In Range("C1:C5") Call CopyItalicUnderlined(cl, Worksheets("Sheet2").Range("A1")) NextEnd SubSub CopyItalicUnderlined(rngToCopy, rngToPaste)rngToCopy.Copy rngToPasteDim iFor 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 WithNextEnd Sub 解决方案 Split() could help, but only after you already found out and parsed italic words since Characters() method can be called on Range object onlyyou could then try the following code:Option ExplicitSub proj() Dim dataRng As range, cl As range Dim arr As Variant Set dataRng = Worksheets("ItalicSourceSheet").range("C1:C5") '<--| change "ItalicSourceSheet" with your actual source sheet name With Worksheets("ItalicOutputSheet") '<--|change "ItalicOutputSheet" with your actual output sheet name For Each cl In dataRng arr = GetItalics(cl) '<--| get array with italic words If IsArray(arr) Then .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(arr) + 1) = Application.Transpose(arr) '<--| if array is filled then write it down to output sheet first blank cell in column "A" Next End WithEnd SubFunction GetItalics(rng As range) As Variant Dim strng As String Dim iEnd As Long, iIni As Long, strngLen As Long strngLen = Len(rng.Value2) iIni = 1 Do While iEnd <= strngLen Do While rng.Characters(iEnd, 1).Font.Italic And rng.Characters(iEnd, 1).Font.Underline If iEnd = strngLen Then Exit Do iEnd = iEnd + 1 Loop If iEnd > iIni Then strng = strng & Mid(rng.Value2, iIni, iEnd - iIni) & "|" iEnd = iEnd + 1 iIni = iEnd Loop If strng <> "" Then GetItalics = Split(Left(strng, Len(strng) - 1), "|")End Function 这篇关于数组拆分和提取vba excel的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！ 上岸，阿里云！
