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

Chip_Kenny

li83829939 发表于 2018-9-28 09:42
怎么样了，大师。

手工做些完成效果檔上載來看看, 說明其中由來, 最好用色去顯示清楚,沒空去了解的表格與資料是如何對號入座。

li83829939

Chip_Kenny 发表于 2018-9-28 10:02
手工做些完成效果檔上載來看看, 說明其中由來, 最好用色去顯示清楚,沒空去了解的表格與資料是如何對號入 ...

就是要这种效果，老师。

li83829939

不知道为什么 发表于 2018-9-27 21:50
这么多要求，看着都绕。

就是要这种效果，大师。

Chip_Kenny

由於打簡體不方便, 在你檔案中加入一頁Setting

1. Sub zz()
   
2. Dim a, b, c, wb As Workbook, ar, n%, t As Boolean, r&, rr&, s$, ss$
   
3. Application.ScreenUpdating = 0
   
4. Set wb = ThisWorkbook
   
5. With Sheets("setting")
   
6.     a = .[a1].Value
   
7.     b = .Range("b1:b" & .[b65536].End(3).Row).Value
   
8.     c = .Range("c1:c" & .[c65536].End(3).Row).Value
   
9. End With
   
10. bb = Array(3, 4, 4, 4)
    
11. For i = 1 To 3
    
12.     s = wb.Sheets(b(1, 1)).Cells(2, 2 + i).Value
    
13.     wb.Sheets(a).Copy
    
14.     Cells(3, 1).Value = Cells(3, 1).Value & s
    
15.     With ActiveWorkbook
    
16.         For j = 1 To UBound(c)
    
17.             t = IIf(j Mod 2, True, False)
    
18.             If t Then r = 7 Else r = 8
    
19.             rr = wb.Sheets(b(j, 1)).Cells(65536, bb(j - 1) + n).End(3).Row
    
20.             ar = wb.Sheets(b(j, 1)).Cells(bb(j - 1), bb(j - 1) + n).Resize(rr)
    
21.             wb.Sheets(c(j, 1)).Copy After:=.Sheets(.Sheets.Count)
    
22.             Cells(r, "e").Resize(rr - bb(j - 1) + 1).NumberFormat = 0
    
23.             Cells(r, "e").Resize(rr - bb(j - 1) + 1) = ar
    
24.         Next
    
25.         n = n + 1
    
26.         .Sheets(1).Activate
    
27.         .SaveAs s
    
28.         .Close
    
29.         ss = ss & Chr(10) & s
    
30.     End With
    
31. Next
    
32. Set wb = Nothing
    
33. Application.ScreenUpdating = 1
    
34. MsgBox n & " files saved as : " & ss
    
35. End Sub

复制代码

li83829939

Chip_Kenny 发表于 2018-9-28 13:22
由於打簡體不方便, 在你檔案中加入一頁Setting

大神加我V 316956195，你的代码我一点没看懂，虚心跟您请教下可以么。或者你留个V或者Q

Chip_Kenny

代碼的效果是你所要的嗎？ 我也是小白，論壇中的老師比比皆是， 有任何問題請在論壇裏求助即可。

li83829939

Chip_Kenny 发表于 2018-9-28 19:23
代碼的效果是你所要的嗎？ 我也是小白，論壇中的老師比比皆是， 有任何問題請在論壇裏求助即可。

效果确实是我想要的效果，本来我是以为你帮我写了VBA代码我可以根据自己的需要修改，但是您写的我却看不懂，实际原来的附件被我阉割了，所以效果是不错的，但是生成后的表少，所以我补了一个全的，您看是否能把代码改一下用文件夹的形式生成。万分感谢！

zpy2

这种格式感觉还是10几年前的，不太方便电脑处理。

Chip_Kenny

新檔真的看到看到~@@~, 給你修改一下代碼及加上一些說明, 希望你能自行修改。
由於說明是繁體, 不知你打開會否亂碼, 在此貼圖。

li83829939

zpy2 发表于 2018-9-29 05:54
这种格式感觉还是10几年前的，不太方便电脑处理。

有解决办法么？