表格转换

源宠宠儿

需要将数据来源表转换为N多份的模板文件  按照地籍号分类   一个地籍号生成一个模板文件  就是要将数据来源表转换成界址标示表   以地籍号为区分依据   一个地籍号要生成一张界址标示表  界址点号对应CAD顺序号   有几个写几个    界址间距对应长度   位置对应界址线位置     

shiruiqiang

你标记的2个，模拟一下完成结果。
否则猜测不出。为啥2个合并单元格差了1行？

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.3.11
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Dim tm: tm = Timer
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     Set sh = ThisWorkbook.Sheets("地籍调查表")
   
7.     For Each sht In Sheets
   
8.         If sht.Name <> sh.Name Then sht.Delete
   
9.     Next
   
10.     p = ThisWorkbook.Path
    
11.     f = p & "\数据来源.xlsx"
    
12.     Set wb = Workbooks.Open(f, 0)
    
13.     With wb.Sheets("Sheet1")
    
14.         r = .Cells(Rows.Count, 1).End(3).Row
    
15.         arr = .[a1].Resize(r, 9)
    
16.         wb.Close False
    
17.     End With
    
18.     For i = 2 To UBound(arr)
    
19.         s = arr(i, 1)
    
20.         If Not d.exists(s) Then Set d(s) = CreateObject("Scripting.Dictionary")
    
21.         d(s)(i) = i
    
22.     Next
    
23.     For Each k In d.keys
    
24.         sh.Copy After:=Sheets(Sheets.Count)
    
25.         Set sht = Sheets(Sheets.Count)
    
26.         m = 5
    
27.         With sht
    
28.             .Name = k
    
29.             .DrawingObjects.Delete
    
30.             For Each kk In d(k).keys
    
31.                 t = d(k)(kk)
    
32.                 .Cells(m, 2) = arr(t, 2)
    
33.                 .Cells(m + 1, 11) = arr(t, 9)
    
34.                 xm = arr(t, 4)
    
35.                 .Cells(m + 1, 21 + xm) = xm
    
36.                 m = m + 2
    
37.             Next
    
38.         End With
    
39.     Next
    
40.     sh.Activate
    
41.     Set d = Nothing
    
42.     Application.ScreenUpdating = True
    
43.     MsgBox "共用时：" & Format(Timer - tm) & "秒！"
    
44. End Sub
    

复制代码

源宠宠儿

shiruiqiang 发表于 2024-3-11 15:49
你标记的2个，模拟一下完成结果。
否则猜测不出。为啥2个合并单元格差了1行？

不是合并  是从右边表格读取数据  填入左边表格   左边的就是模板表  格式不变的

源宠宠儿

ykcbf1100 发表于 2024-3-11 16:10
附件供参考。。。

非常感谢您

yynrzwh

新建文件夹.rar (30.62 KB, 下载次数: 3)

2024-3-12 11:11 上传

点击文件名下载附件