各位老师好，本人初入门小白，诚心请教，请老师们指点迷津，不胜感激。

zpy2 · 发表于 2018-9-29 14:15

li83829939 发表于 2018-9-29 13:56
有解决办法么？

感觉如果拆分还要汇总的，可以试试数据透视表。各种各样指标都可以汇总。

li83829939 · 发表于 2018-9-29 15:24

Chip_Kenny 发表于 2018-9-29 11:43
新檔真的看到看到~@@~, 給你修改一下代碼及加上一些說明, 希望你能自行修改。
由於說明是繁體, 不知你打開 ...

我看了以下但是始终生成后的文件打开还是那几个sheet，其他的sheet生不出来。

Chip_Kenny · 发表于 2018-9-29 15:37

完成效果當然沒改變, 你給出新原数据連表1都沒有, 而且表1中新增的資料全都不知從何而來, 我衹是修改代碼配合頁Setting中的資料, 讓你容易按你自己想要的來修改而已。

li83829939 · 发表于 2018-9-29 16:26

Chip_Kenny 发表于 2018-9-29 15:37
完成效果當然沒改變, 你給出新原数据連表1都沒有, 而且表1中新增的資料全都不知從何而來, 我衹是修改代碼配 ...

恩，老师。我重新把表格整理了一下，然后之前的效果是不错的，只把原数据的四个sheet对应填到后面，然后其他sheet的数据是自动生成的，所以生成的文件夹，从表一开始一直到最后都是要有的。然后我试了下，如果我再航空4后面输入数据好像生成的还是3个，我修改哪个数据可以让生成后的文件数量一直到航空100或者更多。

Chip_Kenny · 发表于 2018-9-29 17:12

將頁Setting的 D2提示儲存格的值改成 "提取航空(1-?)的首儲存格", D3資料儲存格的值改成 "C2", 然後更換以下代碼, 航空(1-?) 便能自動了。

复制代码

Chip_Kenny · 发表于 2018-9-29 17:13

Sub zz()
Dim a, b, c, d, wb As Workbook, ar, n%, t As Boolean, r&, s$, rc%(1)
Application.ScreenUpdating = 0
Set wb = ThisWorkbook
With Sheets("setting")
a = .[a3:b3].Value '建立 a 數組
b = .[c3:d3].Value ''建立 b 數組
c = Sheets(b(1, 1)).Range(b(1, 2)).Column - 1 '變量取列號
c = Sheets(b(1, 1)).Range(b(1, 2)).Offset(1).End(2).Column - c '變量取列號
bb = Sheets(b(1, 1)).Range(b(1, 2)).Resize(1, c).Value '建立航空(1-?)的數組
c = .Range("e3:f" & .[f65536].End(3).Row).Value '建立 c 數組
d = .Range("g3:h" & .[h65536].End(3).Row).Value '建立 d 數組
End With
For i = 1 To UBound(bb, 2) '循環航空(1-?)
wb.Sheets(a(1, 1)).Copy 'Copy 表一
Range(a(1, 2)).Value = Range(a(1, 2)).Value & bb(1, i)
With ActiveWorkbook
For j = 1 To UBound(c) '循環提取資料到相對頁的頁名
rc(0) = Range(c(j, 2)).Row: rc(1) = Range(c(j, 2)).Column + i - 1 '提取儲存格的行列號
r = wb.Sheets(c(j, 1)).Cells(65536, rc(1)).End(3).Row '提取最下儲存格的列號
ar = wb.Sheets(c(j, 1)).Cells(rc(0), rc(1)).Resize(r - rc(0) + 1) '建立 ar 數組
wb.Sheets(d(j, 1)).Copy After:=.Sheets(.Sheets.Count) 'Copy d 數組中的頁
rc(0) = Range(d(j, 2)).Row: rc(1) = Range(d(j, 2)).Column '提取儲存格的行列號
Cells(rc(0), rc(1)).Resize(UBound(ar)).NumberFormat = 0 '將範圍格式
Cells(rc(0), rc(1)).Resize(UBound(ar)) = ar '將資料寫入
Next
.Sheets(1).Activate
.SaveAs bb(1, i) '存檔
.Close
s = s & Chr(10) & bb(1, i)
End With
Next
Set wb = Nothing
Application.ScreenUpdating = 1
MsgBox i - 1 & " files saved as : " & s
End Sub

复制代码

li83829939 · 发表于 2018-9-29 17:38

Chip_Kenny 发表于 2018-9-29 17:13

呃，不好意思啊，可能是我没说清楚，生成后的文件我看还是那5个sheet，我的意思是后面带颜色的sheet生成后的excel都有，表一-表二-表五等。

li83829939 · 发表于 2018-9-29 21:07

Chip_Kenny 发表于 2018-9-29 17:13

呃，不好意思啊，可能是我没说清楚，生成后的文件我看还是那5个sheet，我的意思是后面带颜色的sheet生成后的excel都有表一-表二-表五等，不管有没有数据那些sheet都得有，不能只有有数据的。

Chip_Kenny · 发表于 2018-9-30 11:29

樓主連最基本在求助檔案的密碼都未解除, 叫人如何幫你。

li83829939 · 发表于 2018-9-30 16:15

Chip_Kenny 发表于 2018-9-30 11:29
樓主連最基本在求助檔案的密碼都未解除, 叫人如何幫你。

不好意思啊，老师，密码都去掉了。原数据的四个表一一对应填到后面的表内，然后生成后的航空1、航空2...表一、表一（施工结算）、表二 (折扣后)一直到最后表三丙（管道451）不管有没有数据都要存在；只不过除了原数据对应的4个表是需要手动输入之外，其他都是根据链接自动生成的数据信息。不知道这样描述是否能看明白。。。。

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

[求助] 各位老师好，本人初入门小白，诚心请教，请老师们指点迷津，不胜感激。