[已解决]如何将一行数据拆分成多行

h200797080

原表见附件，求大神解答

MS零件号

总数量

流水号

标准箱数量

批序号

流水号检查

MS零件号

包装数量

流水号

批序号

如何将一行数据拆成多行数据

PGA8A1082029

1016

0001-0005

200

O230606

通过

PGA8A1082029

200

0001

O230606

说明：第一行流水号范围0001-0005

PGA9A1074026

423

0006-0014

50

O230606

通过

PGA8A1082029

200

0002

O230606

总数1016、每箱标准200，因此前4箱都是200

PGA9A1072021

400

0015-0022

50

O230606

通过

PGA8A1082029

200

0003

O230606

最后一箱会多余16 即216 每行的批序号和零件号不变

PGA8A1074022

700

0023-0026

200

O230606

通过

PGA8A1082029

200

0004

O230606

PGA9A1074022

634

0027-0039

50

O230606

通过

PGA8A1082029

216

0005

O230606

最佳答案

月排行榜 / 总排行榜

雪舞子

2015-7-10 11:23

1. Sub 拆分()
   
2.     Dim arr, brr(), i&, j&, n&
   
3.     arr = [a2].CurrentRegion
   
4.     ReDim brr(1 To 6000, 1 To 4)
   
5.     For i = 2 To UBound(arr)
   
6.         If InStr(arr(i, 4), "-") > 0 Then
   
7.             For j = Split(arr(i, 4), "-")(0) To Split(arr(i, 4), "-")(1)
   
8.                 n = n + 1
   
9.                 brr(n, 1) = arr(i, 2)
   
10.                 brr(n, 2) = arr(i, 5)
    
11.                 brr(n, 3) = Format(j, "0000")
    
12.                 brr(n, 4) = arr(i, 6)
    
13.             Next
    
14.             brr(n, 2) = arr(i, 3) - arr(i, 5) * (Split(arr(i, 4), "-")(1) - Split(arr(i, 4), "-")(0))
    
15.         Else
    
16.             n = n + 1
    
17.             brr(n, 1) = arr(i, 2)
    
18.             brr(n, 2) = arr(i, 5)
    
19.             brr(n, 3) = arr(i, 4)
    
20.             brr(n, 4) = arr(i, 6)
    
21.         End If
    
22.     Next
    
23.     [h2:k600] = ""
    
24.     Columns("j").NumberFormatLocal = "@"
    
25.     [h2].Resize(n, 4) = brr
    
26. End Sub

复制代码

包装拆分.rar (19.16 KB, 下载次数: 19)

2015-7-10 11:23 上传

点击文件名下载附件

跳转到最佳答案楼层

zyouong

第一行拆分的最后一行是216，但第二行拆分的却是23，应该是73呀，这两个肯定不具有同一规律。

心正意诚身修

zyouong 发表于 2015-7-9 20:38
第一行拆分的最后一行是216，但第二行拆分的却是23，应该是73呀，这两个肯定不具有同一规律。

我也是这么想的。而且，就算那样，我也是做不出来的。哈哈。。今天多灌水。把任务早点完成。

爱疯

建议附件中只放2个表：

1个是拆分前的，
1个是拆分后的，手动拆分好2条数据

雪舞子

1. Sub 拆分()
   
2.     Dim arr, brr(), i&, j&, n&
   
3.     arr = [a2].CurrentRegion
   
4.     ReDim brr(1 To 6000, 1 To 4)
   
5.     For i = 2 To UBound(arr)
   
6.         If InStr(arr(i, 4), "-") > 0 Then
   
7.             For j = Split(arr(i, 4), "-")(0) To Split(arr(i, 4), "-")(1)
   
8.                 n = n + 1
   
9.                 brr(n, 1) = arr(i, 2)
   
10.                 brr(n, 2) = arr(i, 5)
    
11.                 brr(n, 3) = Format(j, "0000")
    
12.                 brr(n, 4) = arr(i, 6)
    
13.             Next
    
14.             brr(n, 2) = arr(i, 3) - arr(i, 5) * (Split(arr(i, 4), "-")(1) - Split(arr(i, 4), "-")(0))
    
15.         Else
    
16.             n = n + 1
    
17.             brr(n, 1) = arr(i, 2)
    
18.             brr(n, 2) = arr(i, 5)
    
19.             brr(n, 3) = arr(i, 4)
    
20.             brr(n, 4) = arr(i, 6)
    
21.         End If
    
22.     Next
    
23.     [h2:k600] = ""
    
24.     Columns("j").NumberFormatLocal = "@"
    
25.     [h2].Resize(n, 4) = brr
    
26. End Sub

复制代码

包装拆分.rar (19.16 KB, 下载次数: 19)

2015-7-10 11:23 上传

点击文件名下载附件

h200797080

zyouong 发表于 2015-7-9 20:38
第一行拆分的最后一行是216，但第二行拆分的却是23，应该是73呀，这两个肯定不具有同一规律。

呵呵 看到箱数了吗

h200797080

这个后来自己也用VBA做出来了 虽然代码大多是直接套Excel公式{:1212:}
Sub 文件制作()
Dim i, j, m, n, k As Integer
Range("F" & 2) = "=IF(and（(IF(LEN(C2)=4,1,RIGHT(C2,4)-LEFT(C2,4)+1)+1)*D2>B2，(IF(LEN(C2)=4,1,RIGHT(C2,4)-LEFT(C2,4)+1）-1)*D2<B2）,""通过"",""不通过"")"
Range("F2").AutoFill Range("F2:F" & [a65536].End(xlUp).Row)
Range("g2") = "=IF(LEN(C2)=4,1,RIGHT(C2,4)-LEFT(C2,4)+1)"
Range("g2").AutoFill Range("g2:g" & [a65536].End(xlUp).Row)
Range("O2") = "=MID(E2,4,2)&MID(E2,2,2)"
Range("O2").AutoFill Range("O2:O" & [a65536].End(xlUp).Row)
For n = 2 To [a65536].End(xlUp).Row
If Range("F" & n) = "通过" Then
Range("F" & n).Value = Left(Range("c" & n), 4)
Else
MsgBox "数据检查不通过，流水号与包装量不匹配"
GoTo 99
End If
Next
j = 2
For i = 2 To [a65536].End(xlUp).Row
For m = 1 To Range("G" & i)
Range("H" & j) = Range("A" & i)
Range("K" & j) = Range("E" & i)
Range("" & j) = Range("O" & i)
Range("I" & j) = Range("F" & i) + m - 1
If Range("G" & i) = 1 Or m = Range("G" & i) Then
Range("J" & j) = Range("b" & i) - (m - 1) * Range("d" & i)
  If Range("J" & j) < 0 Then
  Range("J" & j) = Range("b" & i) - (m - 2) * Range("d" & i)
  End If
Else
Range("J" & j) = Range("d" & i)
End If
j = j + 1
Next
Next
Range("N2") = "=YEAR(TODAY())"
Range("N2").AutoFill Range("N2:N" & [h65536].End(xlUp).Row)
Range("Q2") = "=RIGHT(N2,2)&2"
Range("Q2").AutoFill Range("Q2:Q" & [h65536].End(xlUp).Row)
Range("L2") = "=TEXT(I2,""0000"")"
Range("L2").AutoFill Range("L2:L" & [h65536].End(xlUp).Row)
Range("M2") = "=""BM11201""&Q2&l2"
Range("M2").AutoFill Range("M2:M" & [h65536].End(xlUp).Row)

99
End Sub