[已解决]分列求助！！！

zzh130190

举例：A空格B空格C空格D，在一个单元格中，ABCD分别为文本或数据，但都被空格分开。要求得到结果：必须分为两列，有时需要A与B之间的空格分列，有时要求BC之间空格分列，求助各位大神解答！感谢！

最佳答案

月排行榜 / 总排行榜

林木水

2021-12-20 17:56

可以解决需求了吧，解决问题请给最佳，养成好习惯

跳转到最佳答案楼层

过儿

可以find查找位置，然后截取，如果查找第二个空格，可以用find(" ",A1,FIND(" ",A1)+1)

zzh130190

过儿 发表于 2021-12-18 12:08
可以find查找位置，然后截取，如果查找第二个空格，可以用find(" ",A1,FIND(" ",A1)+1)

这位大神，可能我不太会用，我按您说的试了，没有成功，您帮看看我的表格，我传在附件里了

林木水

1. <blockquote>Sub 正

复制代码

则表达式()

正则表达式，不是妥妥的，我给你弄弄，代码如上，附件如下跟结果，如果有区别，那就把需求规则明确清楚
如果需要把L型也删掉，就添加红色字体这部分，如果之前规则已经匹配，就删掉

Option Explicit
Sub 正则表达式()
    Dim arr
'    Dim reg As New RegExp  直接引用
    Dim brr(), k As Integer, i As Integer
    Dim reg As Object
    Set reg = CreateObject("VBSCRIPT.RegExp")   '调用
    arr = Range("c2:c" & Cells(Rows.Count, "c").End(xlUp).Row)
    With reg
        .Global = True
        .MultiLine = True
        .Pattern = "^[\u4e00-\u9fa5]{1,}\s*[\u4e00-\u9fa5]{1,}|\w*[\u4e00-\u9fa5]{1,}"
        For i = 1 To UBound(arr, 1)
            ReDim Preserve brr(1 To i)
            brr(i) = .Replace(arr(i, 1), "")
        Next i
    End With
        Range("D2").Resize(Cells(Rows.Count, "c").End(xlUp).Row) = ""
        Range("D2").Resize(UBound(arr)) = Application.Transpose(brr)
End Sub

songxueyi1

没说清楚啥时候AB分列，啥时候BC分列。文本和数据的判断依据或者规则是什么？

zzh130190

林木水 发表于 2021-12-18 17:14
则表达式()
正则表达式，不是妥妥的，我给你弄弄，代码如上，附件如下跟结果，如果有区别，那就把需求规 ...

首先感谢这位大神的解答，根据你上传的图片确实达到了我想要的结果，但我还是没搞懂怎么使用，期望再次解答，谢谢！

zzh130190

林木水 发表于 2021-12-18 17:14
则表达式()
正则表达式，不是妥妥的，我给你弄弄，代码如上，附件如下跟结果，如果有区别，那就把需求规 ...

另外这位大神，我刚才下载了你上传的附件，知道是在宏中写入代码了，也会用了，但是虽然将B列完美提出，但A列没有提出来。其实我是想让目标单元格里面的内容分为两列：物资名称为一列、规格型号为一列。

zzh130190

示例如图

zzh130190

songxueyi1 发表于 2021-12-18 19:27
没说清楚啥时候AB分列，啥时候BC分列。文本和数据的判断依据或者规则是什么？

这位大神，规则应该是前边的汉字提出来为一列，剩余的部分提出来为一列就可以

林木水

zzh130190 发表于 2021-12-19 17:49
另外这位大神，我刚才下载了你上传的附件，知道是在宏中写入代码了，也会用了，但是虽然将B列完美提出， ...

1. Sub 正则表达式()
   
2.     Dim arr, brr1(), brr2(), k As Integer, i As Integer, m, mat
   
3. '    Dim reg As New RegExp
   
4.     Dim reg As Object
   
5.     Set reg = CreateObject("vbscript.RegExp")
   
6.     arr = Range("c2:c" & Cells(Rows.Count, "c").End(xlUp).Row)
   
7.     With reg
   
8.         .Global = True
   
9.         .MultiLine = True
   
10.         .Pattern = "(^[\u4e00-\u9fa5]{1,}\s*[\u4e00-\u9fa5]{1,})([^\u4e00-\u9fa5].*)"
    
11.         For i = 1 To UBound(arr, 1)
    
12.             Set mat = .Execute(arr(i, 1))
    
13.                     For Each m In mat
    
14.                         ReDim Preserve brr1(1 To i)
    
15.                         ReDim Preserve brr2(1 To i)
    
16.                         brr1(i) = m.SubMatches(0)
    
17.                         brr2(i) = m.SubMatches(1)
    
18.                     Next m
    
19.         Next i
    
20.     End With
    
21.         Range("D2").Resize(Cells(Rows.Count, "c").End(xlUp).Row, 2) = ""
    
22.         Range("D2").Resize(UBound(arr)) = Application.Transpose(brr2)
    
23.         Range("e2").Resize(UBound(arr)) = Application.Transpose(brr1)
    
24. End Sub

复制代码

改了一下，你看下，你要用直接使用我这个附件，或者自己先插入一列。见附件，解决问题给最佳