打印 上一主题 下一主题将EXCEL表格中的指定内容提取组成新表格（数据整理）

小白兔了白了白

求助各位大神，数据整理，内附源数据清单，希望将内容指定内容提出（按模板格式）。谢谢，急求

3190496160

规范清单，猜是想根据数据源的i  列来提取，但是，飞走材料清单就是一头雾水了

高个子

3190496160 发表于 2023-2-2 09:30
规范清单，猜是想根据数据源的i  列来提取，但是，飞走材料清单就是一头雾水了

看懂了，规范清单是想根据数据源的G列来提取，比如G49EN1=P00000010|管道系统的安装按CPS1210。|CPS1210
EN2=P00000106|装配车间操作按CPS2000。|CPS2000
EN3=P00000131|螺栓螺母的安装按CPS2120。|CPS2120
EN4=P00000464|零件和装配件的标识按CPS9010。|CPS9010
FL1=管路系统安装按221GD601执行
FL2=在通风软管16139X0X0000外侧包裹绿包布EN6049-006-40-5保护套，使用AA52081-C-2对保护套进行绑扎，至少扎三个结。允许包裹绿包布的通风软管与周围的线束、结构、支架接触。
提取所有CPS和后面的数字并去重

飞走材料清单是比如数据源Q269
粘接定义1={防磨边EN按EN7中粘接材料1或者粘接材料2的施工要求和固化的规定粘接######FL1###CMS-SL-103|B类1/2级###CMS-SL-103|B类2级};
提取CMS-SL-103和对应B列的值

小白兔了白了白

高个子 发表于 2023-2-2 10:02
看懂了，规范清单是想根据数据源的G列来提取，比如G49EN1=P00000010|管道系统的安装按CPS1210。|CPS1210
...

感谢大佬回复。工艺规范是的，飞走材料提取的是CMS-SL-103|B类1/2级和CMS-SL-103|B类2级以及对应的B列需要把类型级别也提取。

3190496160

Sub 规范清单()
Application.ScreenUpdating = False
Dim ar As Variant
Dim br()
With Sheets("报表 1")
    r = .Cells(Rows.Count, 7).End(xlUp).Row
    If r < 2 Then MsgBox "报表 1为空！": End
    ar = .Range("g1:g" & r)
End With
ReDim br(1 To 100000, 1 To 2)
n = 1
br(n, 1) = "序号"
br(n, 2) = "规范号"
For i = 2 To UBound(ar)
    If Not IsError(ar(i, 1)) Then
        If Trim(ar(i, 1)) <> "" Then
            If InStr(ar(i, 1), "|") > 0 Then
                If InStr(ar(i, 1), Chr(10)) = 0 Then
                    n = n + 1
                    br(n, 1) = n - 1
                    mr = Split(ar(i, 1), "|")
                    br(n, 2) = mr(UBound(mr))
                Else
                    rr = Split(ar(i, 1), Chr(10))
                    For s = 0 To UBound(rr)
                        If InStr(rr(s), "|") > 0 Then
                            n = n + 1
                            br(n, 1) = n - 1
                            mr = Split(rr(s), "|")
                            br(n, 2) = mr(UBound(mr))
                        End If
                    Next s
                End If
            End If
        End If
    End If
Next i
If n = 1 Then MsgBox "没有需要汇总的规范号！": End
Set wb = Workbooks.Add
With wb.Worksheets(1)
    .[a1].Resize(n, 2) = br
End With
wb.SaveAs Filename:=ThisWorkbook.Path & "\规范清单.xlsx"
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

3190496160

数据提取.rar (2 MB, 下载次数: 6)

2023-2-2 12:32 上传

点击文件名下载附件

3190496160

只写了规范材料清单的代码，飞走材料提取那些数据实在是看不懂