|
→案例需求： 将下图1中B列句子，按空格、标点符号分割开，单独列为1行。 图1 图2 →思路分析： 首先就想到用Split函数，以空格作为分隔符号把英文句子分割开。我们先熟悉下Split函数。 ●使用方法：Split(需要分割的字符串,分隔符) 通俗的说：Split 函数给他一个分隔符，能把字符串分割开，并返回一个下标从零开始的一维数组。（重点：①下标从0开始②一维数组） 仿佛可以解决问题了，但是还有一个条件：句子中除了空格，标点符号也要做为分隔符。 Split只能设置一种分隔符，如何实现多种分隔符实现成功分割字符串呢？ ●解决办法： 我们在使用Split函数之前，把其他的标点符号，全部替换为空格即可。这样子，可以一次性实现分以空格作为分隔符分割字符串。 →最终代码： 里面除了数组转置自定义函数可以借鉴，其他的都是上面编程逻辑的体现，理解了上面说的，下面的东西很简单。 Sub test() Dim crr() k = 0 Set sht2 = Worksheets("原始数据") arr = Intersect(sht2.UsedRange, sht2.Cells) For i = 2 To UBound(arr) brr = Split(replacestr(arr(i, 2)), " ") '以空格作为分隔符，分割字符串 For j = 0 To UBound(brr) '分割完成，循环写入数组crr k = k + 1 ReDim Preserve crr(1 To UBound(arr, 2), 1 To k) For m = 1 To UBound(arr, 2) 'For循环，将英文句子同一行的内容写入数组Crr crr(m, k) = arr(i, m) Next crr(2, k) = brr(j) Next Next '//开始写入结果 Set sht = Worksheets("结果") sht.UsedRange.Clear '清空原有数据 Worksheets("原始数据").Rows(1).Copy sht.Range("a1") sht.Range("a2").Resize(UBound(crr, 2), UBound(crr)) = Transpose2(crr) sht.Columns.AutoFit MsgBox ("完成！")End SubFunction replacestr(strr) '自定义函数，替换标点符号为空格，为下一步 '用空格分割句子做准备 replacestr = Replace(strr, ",", " ,") replacestr = Replace(replacestr, ".", " .") replacestr = Replace(replacestr, """", " "" ") replacestr = Replace(replacestr, "?", " ? ") replacestr = Trim(replacestr)End Function数组转置自定义函数： Function Transpose2(arr As Variant)'自定义数组转置函数，突破工作表函数Transpose的限制 Dim brr(), i, j, n n = NumberOfArrayDimensions(arr) If n = 1 Then ReDim brr(LBound(arr) To UBound(arr), 1 To 1) For i = LBound(arr) To UBound(arr) brr(i, 1) = arr(i) Next Else ReDim brr(LBound(arr, 2) To UBound(arr, 2), LBound(arr) To UBound(arr)) For i = LBound(arr) To UBound(arr) For j = LBound(arr, 2) To UBound(arr, 2) brr(j, i) = arr(i, j) Next Next End If Transpose2 = brrEnd FunctionPublic Function NumberOfArrayDimensions(arr As Variant) As Integer Dim Ndx As Integer Dim Res As Integer On Error Resume Next Do Ndx = Ndx + 1 Res = UBound(arr, Ndx) Loop Until Err.Number <> 0 NumberOfArrayDimensions = Ndx - 1End Function |
|
|
