Office中国论坛/Access中国论坛

标题: 数据拆分提取，难度有点大请大家帮忙 [打印本页]

作者: GOODWIN 时间: 2021-8-2 19:27
标题: 数据拆分提取，难度有点大请大家帮忙
本帖最后由 GOODWIN 于 2021-8-3 07:50 编辑

整理前数据：

MV站别	料号	规格	用量	零件位置	零件类型	料架类型	S
Z-01	0341-012-306	1/10W 10ohm F 0603	3	R816,R861,R897 <0341012315(1/10W 10ohm F 0603)> <0341012332(1/11W 10ohm F 0603)> <0341012333(1/12W 10ohm F 0603)> <0341012334(1/13W 10ohm F 0603)> <0341012335(1/14W 10ohm F 0603)>	1608R	8*4P
Z-04	0341-041-306	1/10W 1Kohm F 0603	11	R638,R742,R746,R785 <0341041332(1/10W 11Kohm F 0603)> <0341041333(1/10W 1Kohm F 0603)	1608R	8*4P
Z-85	2610-049-742	M24C02-WMN6TP	1	IC603<2610-049-755(M24C02-WMN8TP)>	SOIC-8P	12*8E
Z-86	2610-894-137	PIC18F26K22T-I/SS	1	IC803	SOIC-28P	16*12E
Z-87	2610-756-437	DSPIC33FJ64GS606T-I/PT	1	IC703	QFP-64P	24*16E

整理后数据：

料号	规格	用量	零件位置	S
0341-012-306	1/10W 10ohm F 0603	3	R816,R861,R897
0341012315	1/10W 10ohm F 0603	3	R816,R861,R897	S
0341012332	1/10W 11ohm F 0603	3	R816,R861,R897	S
0341012333	1/10W 12ohm F 0603	3	R816,R861,R897	S
0341012334	1/10W 13ohm F 0603	3	R816,R861,R897	S
0341012335	1/10W 14ohm F 0603	3	R816,R861,R897	S
0341-041-306	1/10W 1Kohm F 0603	11	R638,R742,R746,R785
0341041332	1/10W 11Kohm F 0603)	11	R638,R742,R746,R785	S
0341041333	1/10W 1Kohm F 0603	11	R638,R742,R746,R785	S
2610-049-742	M24C02-WMN6TP	1	IC603
2610-049-755	M24C02-WMN8TP	1	IC603	S
2610-894-137	PIC18F26K22T-I/SS	1	IC803
2610-756-437	DSPIC33FJ64GS606T-I/PT	1	IC703

需要将替代的物料与原物料一起提取出来显示，并对提取的物料在S列进行标注S，表示该物料为替代料

位置说明R816,R861,R897
<0341012315(1/10W 10ohm F 0603)>
<0341012332(1/11W 10ohm F 0603)>
<0341012333(1/12W 10ohm F 0603)>
<0341012334(1/13W 10ohm F 0603)>
<0341012335(1/14W 10ohm F 0603)>
表示0341-012-306有5个替代物料，红色代表第一个替代料，蓝色代表第一替代料的规格，依照<()>来区分一共有几个，对替代物料进行分解显示，并在分解后的替代物料S栏用S表示己分解的替代料
[attach]64121[/attach]

作者: GOODWIN 时间: 2021-8-2 19:29

Dim strsql1 As String
strsql1 = "SELECT Mid([零件位置],InStr([零件位置],'<')+1,(InStr([零件位置],'(')-1)-(InStr([零件位置],'<'))) " _
& "AS 料号, Mid([零件位置],InStr([零件位置],'(')+1,(InStr([零件位置],')')-1)-(InStr([零件位置],'('))) " _
& "AS 规格, 整理前.用量, Mid([零件位置],1,InStr([零件位置],'<')-2) " _
& "AS 整理后零件位置 INTO 整理后 " _
& "FROM 整理前 " _
& "WHERE (((InStr([零件位置],'<'))>0))"
DoCmd.RunSQL strsql1
这样执行只能处理一个<()>内的数据，当有多个时就只能保留第一个

麻烦各位老师帮忙解决，谢谢

作者: GOODWIN 时间: 2021-8-3 07:49
Sub test()
Dim i%, j%, k%, arr, arr1
arr = Sheet1.[a1].CurrentRegion
j = 2
For i = 2 To UBound(arr)
      With Sheets(2)
         Sheets(1).Activate
         Range(Cells(i, 2), Cells(i, 4)).Copy .Cells(j, 1)
         If InStr(arr(i, 5), "<") Then
            arr1 = Split(arr(i, 5), "<")
            .Cells(j, 4) = arr1(0): j = j + 1

            For k = 1 To UBound(arr1)
                  .Cells(j, 1) = Split(arr1(k), "(")(0)
                  .Cells(j, 2) = Split(Replace(arr1(k), ")", "("), "(")(1)
                  .Range(.Cells(j - 1, 3), .Cells(j - 1, 4)).Copy .Cells(j, 3)
                  j = j + 1

                  Next
         Else
            Sheet1.Cells(i, 5).Copy .Cells(j, 4)
            j = j + 1
         End If
      End With
Next
End Sub

这个怎么样改成ACCESS的代码？

作者: Henry D. Sy 时间: 2021-8-3 10:51
看不懂

作者: accessir 时间: 2021-8-12 14:00
给你一个例子，供参考。

作者: GOODWIN 时间: 2021-8-12 16:40

accessir 发表于 2021-8-12 14:00
给你一个例子，供参考。

谢谢大神的指导，己完美解决！感谢

作者: lingjiang 时间: 2021-8-13 21:57
学习

作者: 灰太郎 时间: 2021-9-8 07:58
收到

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)