[已解决]如何实现由原始表和汇总表的自动生成？

jeanpion · 发表于 2015-5-11 09:00

如何实现由原始数据（表2和表3）生成汇总数据（表1），反之，有表1的数据后，可以生成表2和表3的数据。
因为汇总表按品名汇总的，原始数据是按天记录的，感觉有点儿难了。

最佳答案

grf1973

2015-5-12 11:08

Sub 生成入库单()
Set d = CreateObject("scripting.dictionary")
For Each sh In Worksheets
dw = Right(sh.[i2], 1)
If InStr(sh.Name, "库单") = 0 Then
arr = sh.Range("a4:j19")
For i = 1 To UBound(arr)
For k = 1 To 10 Step 5
x = arr(i, k)
If Len(x) > 0 Then
xmonth = Split(x, ".")(0): xday = Split(x, ".")(1)
x = DateSerial(2015, xmonth, xday)
If arr(i, k + 2) > 0 Then d(x) = d(x) & "," & sh.Name & "," & dw & "," & arr(i, k + 2)
End If
Next
Next
End If
Next
n = -10: k = 0
Application.ScreenUpdating = False
With Sheets("入库单")
.[a:f] = ""
Set copyrng = .Range("J1:O10")
For Each x In d.keys
k = k + 1
xrr = Split(d(x), ",")
n = n + 11
copyrng.Copy .Cells(n, 1)
s = 0
.Cells(n + 1, 1) = "编号：" & Format(k, "000")
.Cells(n + 1, 3) = x
For i = 1 To UBound(xrr) Step 3
s = s + 1
If s = 6 Then
s = 1
n = n + 11
k = k + 1
copyrng.Copy .Cells(n, 1)
.Cells(n + 1, 1) = "编号：" & Format(k, "000")
.Cells(n + 1, 3) = x
End If
.Cells(n + s + 2, 1) = s
.Cells(n + s + 2, 2) = xrr(i)
.Cells(n + s + 2, 3) = xrr(i + 1)
.Cells(n + s + 2, 5) = xrr(i + 2)
Next
Next
End With
Application.ScreenUpdating = True
End Sub

复制代码

Excel学徒123 · 发表于 2015-5-11 09:17

建议你重新设计表格结构，你这不是玩Excel，是被Excel玩

jeanpion · 发表于 2015-5-11 11:38

Excel学徒123 发表于 2015-5-11 09:17
建议你重新设计表格结构，你这不是玩Excel，是被Excel玩

表格是固定了的，全市统一了的。这样搞的话真的很麻烦，而且这到还要制成模板了发给企业的（企业人员水平比我还低，只会用）。所以我想要做的就是要么录入出库单和入库单，要么只录入过录表，另一边的数据直接就出来。

grf1973 · 发表于 2015-5-11 12:57

表格里自己填点内容再说，空表格叫人如何汇总。

jeanpion · 发表于 2015-5-11 14:38

grf1973 发表于 2015-5-11 12:57
表格里自己填点内容再说，空表格叫人如何汇总。

好的，就是将各种产品的汇总按天分到每张入库出库单中去。

grf1973 · 发表于 2015-5-12 11:08

Sub 生成入库单()
Set d = CreateObject("scripting.dictionary")
For Each sh In Worksheets
dw = Right(sh.[i2], 1)
If InStr(sh.Name, "库单") = 0 Then
arr = sh.Range("a4:j19")
For i = 1 To UBound(arr)
For k = 1 To 10 Step 5
x = arr(i, k)
If Len(x) > 0 Then
xmonth = Split(x, ".")(0): xday = Split(x, ".")(1)
x = DateSerial(2015, xmonth, xday)
If arr(i, k + 2) > 0 Then d(x) = d(x) & "," & sh.Name & "," & dw & "," & arr(i, k + 2)
End If
Next
Next
End If
Next
n = -10: k = 0
Application.ScreenUpdating = False
With Sheets("入库单")
.[a:f] = ""
Set copyrng = .Range("J1:O10")
For Each x In d.keys
k = k + 1
xrr = Split(d(x), ",")
n = n + 11
copyrng.Copy .Cells(n, 1)
s = 0
.Cells(n + 1, 1) = "编号：" & Format(k, "000")
.Cells(n + 1, 3) = x
For i = 1 To UBound(xrr) Step 3
s = s + 1
If s = 6 Then
s = 1
n = n + 11
k = k + 1
copyrng.Copy .Cells(n, 1)
.Cells(n + 1, 1) = "编号：" & Format(k, "000")
.Cells(n + 1, 3) = x
End If
.Cells(n + s + 2, 1) = s
.Cells(n + s + 2, 2) = xrr(i)
.Cells(n + s + 2, 3) = xrr(i + 1)
.Cells(n + s + 2, 5) = xrr(i + 2)
Next
Next
End With
Application.ScreenUpdating = True
End Sub

复制代码

jeanpion · 发表于 2015-5-12 12:01

grf1973 发表于 2015-5-12 11:08

谢谢，太厉害了！

cjfeeling · 发表于 2015-5-12 15:57

grf1973 发表于 2015-5-12 11:08

我是新人，可不可以帮我看看帖子http://www.excelpx.com/thread-343048-1-1.html

jeanpion · 发表于 2015-5-15 17:05

grf1973 发表于 2015-5-12 11:08

大师，还有一个问题，第一列可以执行（A1：A19），后面的（F1：F19）不能行啊。也就是说只点自动生成后，F1-F9内的日期没有执行。是不是还要加一段代码？

jeanpion · 发表于 2015-5-15 17:11

grf1973 发表于 2015-5-12 11:08

对不起，我表述错了，能不能让编号先排A4-A19，再排F4-F19？第编号001是1月1日，编号002是1月18日，编号003又到1月4日了感觉不是很符合逻辑。

		自动登录	找回密码
密码			注册