表格整理求助

kdsea

Sub 化验整理()
Dim reg As Object
    Set reg = CreateObject("vbscript.regexp")
    Dim sr, x
    For x = 1 To Range("a65536").End(xlUp).Row
        sr = Cells(x, 1)
        With reg
            .Global = True
            .IgnoreCase = True
            .Pattern = "(天|丰)"
            For Each Item In .Execute(sr)
                ss = ss & Item
            Next
            Cells(x + 1, 3) = ss
        End With
        ss = ""
    Next x
'=======================================================
Set reg = CreateObject("vbscript.regexp")
   
    For x = 1 To Range("a65536").End(xlUp).Row
        sr = Cells(x, 1)
        With reg
            .Global = True
            .IgnoreCase = True
            .Pattern = " (.*)(?=样)"
            For Each Item In .Execute(sr)
                ss = ss & Item
            Next
            Cells(x + 1, 3) = ss
        End With
        ss = ""
    Next x


'=======================================================
Set reg = CreateObject("vbscript.regexp")
   
    For x = 1 To Range("a65536").End(xlUp).Row
        sr = Cells(x, 1)
        With reg
            .Global = True
            .IgnoreCase = True
            .Pattern = "\d+月\d+(号|日)"
            For Each Item In .Execute(sr)
                ss = ss & Item
            Next
            Cells(x + 1, 2) = ss
        End With
        ss = ""
    Next x




'==========================================================
a = Array("低位") ', "水分：", "空干基挥发：", "硫：")
    For i = 2 To 10
   
        For Each aa In a  '遍历字符
            k = InStr(Cells(i, 1), aa) '如果包含字符，那么k的值大于0，否则等于0
            If k > 0 Then
                kk = Len(aa) + k '//返回第一个数字的位置
                Cells(i, 5) = Val(Mid(Cells(i, 1), kk, 99))  '读取数字
            End If
        Next
    Next
a = Array("水分:") ', "空干基挥发：", "硫：")
    For i = 2 To 10
   
        For Each aa In a  '遍历字符
            k = InStr(Cells(i, 1), aa) '如果包含字符，那么k的值大于0，否则等于0
            If k > 0 Then
                kk = Len(aa) + k '//返回第一个数字的位置
                Cells(i, 6) = Val(Mid(Cells(i, 1), kk, 99))  '读取数字
            End If
        Next
    Next
a = Array("硫:")
    For i = 2 To 10
   
        For Each aa In a  '遍历字符
            k = InStr(Cells(i, 1), aa) '如果包含字符，那么k的值大于0，否则等于0
            If k > 0 Then
                kk = Len(aa) + k '//返回第一个数字的位置
                Cells(i, 7) = Val(Mid(Cells(i, 1), kk, 99))  '读取数字
            End If
        Next
    Next
    a = Array("空干基挥发:")
    For i = 2 To 10
   
        For Each aa In a  '遍历字符
            k = InStr(Cells(i, 1), aa) '如果包含字符，那么k的值大于0，否则等于0
            If k > 0 Then
                kk = Len(aa) + k '//返回第一个数字的位置
                Cells(i, 8) = Val(Mid(Cells(i, 1), kk, 99))  '读取数字
            End If
        Next
    Next
End Sub

拼凑成这样了，可以使用，哪位大师给整理一下

kdsea

东拼西凑，请大师给整理通顺一些

zpy2

kdsea 发表于 2023-2-22 15:31
东拼西凑，请大师给整理通顺一些

create temp table aa as
select iif(regexp('\d月\d',F_A),rowid,'') 序, regexp2('\d+月\d+(号|日)',F_A) 日期, regexp2('(天|丰)',F_A) 场地,regexp2('高位(\d+)',F_A,1) 热量,regexp2('水分:([\d\.]+)',F_A,1) 水分, regexp2('挥发:([\d\.]+)',F_A,1) 挥发,regexp2('硫:([\d\.]+)',F_A,1) 硫 from 正则表达式拆分数据清洗日期场地;
create temp table bb as
select fillna(序) 序,日期,场地,热量,水分,挥发,硫 from aa;
select 序,group_concat(日期,'') 日期,group_concat(场地,'') 场地,group_concat(热量,'') 热量,group_concat(水分,'') 水分,group_concat(挥发,'') 挥发,group_concat(硫,'') 硫 from bb group by 序;

洋务德雷

正则表达式可以解决。

kdsea

非常感谢各位老师的指导  ，现在可以使用了