求助！！！VBA 怎么按照特定字符拆分某列？

gushoucheng

gwjkkkkk

方法1：
方法2：vba

1. Sub 按钮1_Click()
   
2. Dim arr, brr(), i%, j%, r
   
3. arr =
   
4. [G1].CurrentRegion
   
5. ReDim brr(1 To UBound(arr), 1 To 2)
   
6. For i = 1 To
   
7. UBound(arr)
   
8.   r = Split(arr(i, 1), "色")
   
9.   brr(i, 1) = r(0):
   
10. brr(i, 2) = r(1)
    
11. Next i
    
12. [h1].Resize(UBound(brr), UBound(brr, 2)) =
    
13. brr
    
14. End Sub

复制代码

gushoucheng

用Split下标越界~

hmlstfqtl

1. =TRIM(MID(SUBSTITUTE($G2,"色",REPT(" ",99)),COLUMN(A$1)*99-98,99))

复制代码

gushoucheng

hmlstfqtl 发表于 2022-5-3 19:44

麻烦问一下~用VBA中的Split和数组结合怎么弄啊？数组公式计算太慢了，数据量有点大~

geoqiang

gushoucheng 发表于 2022-5-3 21:28
麻烦问一下~用VBA中的Split和数组结合怎么弄啊？数组公式计算太慢了，数据量有点大~

看到个地质人的帖子不容易啊
兄弟,上传附件更容易获得帮助!

1. Sub 岩性分割()
   
2.     最大行 = Sheet1.Cells(Rows.Count, "H").End(xlUp).Row '你的数据在那一列就改成那一列
   
3.     '源数据赋值给数组
   
4.     arr源数据 = Sheet1.Range("H1:H" & 最大行)
   
5.     '定义个结果数组
   
6.     ReDim arr结果(1 To UBound(arr源数据), 1 To 2) ' 第一列颜色 第二列岩性
   
7.     '循环数组arr源数据,进行拆分
   
8.     For i = LBound(arr源数据) To UBound(arr源数据)
   
9.         s = arr源数据(i, 1) '注意 数组arr源数据也是二维数组
   
10.         s = Replace(s, "色", "色,") '这样替换为了将来颜色数据中带有"色"字
    
11.         trr = Split(s, ",")
    
12.         arr结果(i, 1) = trr(0) '颜色
    
13.         arr结果(i, 2) = trr(1) '岩性
    
14.     Next
    
15.     ' 结果写入excel工作表,根据自己的实际需要更改写入工作表及位置
    
16.     Sheet1.[J1].Resize(UBound(arr结果), UBound(arr结果, 2)).ClearContents '先清除写入区域的内容
    
17.     Sheet1.[J1].Resize(UBound(arr结果), UBound(arr结果, 2)) = arr结果 '写入
    
18. End Sub

复制代码

hmlstfqtl

最简单的
mid(g2,1,find("色"g2)-1)
mid(g2,find("色"g2)+1,99)

hmlstfqtl

最简单的
=mid(g2,1,find("色",g2)-1)
=mid(g2,find("色",g2)+1,99)

hmlstfqtl

lsbenet

感谢分享！