提取特定字符并增加到特定的行

hsjmshen

详细情况见附件。运行附件中VBA时其中33行语句设定备注列提取的是A列的最后一字，但实际上我的表中备注栏所指可以是A列中任何位置的字，这时备注栏就提取不出来了。比如附件表中第6行的“洪”字在备注栏本有字，却没能提取。请问这个VBA中的第33句可以修改成任意位置的字吗？或者说根据备注栏中加引号的字来确定该提取A栏的哪个字。备注栏中都用引号指明了A栏中的字，并且多数是备注栏的头一个字。
字符拆分.rar (21.21 KB, 下载次数: 11)

2018-9-16 14:23 上传

点击文件名下载附件

hsjmshen

请高手指教！

hsjmshen

看来这个问题比较麻烦。

grf1973

只能做到尽量接近。

1. Sub grf()
   
2.     arr = Sheets(1).[a1].CurrentRegion.Value
   
3.     ReDim brr(1 To 10000, 1 To UBound(arr, 2))
   
4.     For i = 1 To UBound(arr)
   
5.         x = arr(i, 1)
   
6.         bz = arr(i, 8)
   
7.         For k = 1 To Len(x)
   
8.             n = n + 1
   
9.             For j = 1 To UBound(arr, 2)
   
10.                 brr(n, j) = arr(i, j)
    
11.             Next
    
12.             brr(n, 1) = Mid(x, k, 1)
    
13.             If brr(n, 1) <> "□" Then brr(n, 6) = ""
    
14.             brr(n, 7) = 1
    
15.             If Len(bz) > 0 Then
    
16.                 xx = Mid(bz, 2, 1)
    
17.                 If brr(n, 1) <> xx Then brr(n, 8) = ""
    
18.             End If
    
19.         Next
    
20.     Next
    
21.     Sheets(2).[a1].Resize(n, UBound(arr, 2)) = brr

复制代码

hsjmshen

grf1973 发表于 2018-9-17 16:56
只能做到尽量接近。

谢谢你的帮助！我已将A列中要提取到备注列的字体颜色修改成绿色，基本上解决问题了。不过还是谢谢你的热心帮助！