批量提取楼栋住户信息

酉水滔滔

zpy2 发表于 2024-3-15 14:06
//select * from consolidateSheet limit 500;
create temp table aa as
select rowid old_rowid, filln ...

谢谢！不过我水平太浅，您写的这些语句我不知道在哪里运行？

ykcbf1100

参与一下。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.3.17
   
2.     Dim arr, d
   
3.     Application.ScreenUpdating = False
   
4.     ReDim brr(1 To 1000, 1 To 4)
   
5.     With Sheets("数据源")
   
6.         arr = .[a1].Resize(14, 13)
   
7.         dh = arr(1, 3)
   
8.         For i = UBound(arr) To 3 Step -2
   
9.             p2 = arr(i - 1, 1)
   
10.             For j = 3 To UBound(arr, 2)
    
11.                 If arr(i, j) <> Empty Then
    
12.                     m = m + 1
    
13.                     brr(m, 1) = dh
    
14.                     brr(m, 2) = p2
    
15.                     brr(m, 3) = arr(i - 1, j)
    
16.                     brr(m, 4) = arr(i, j)
    
17.                 End If
    
18.             Next
    
19.         Next
    
20.         arr = .[a17].Resize(10, 8)
    
21.         dh = arr(1, 3)
    
22.         For i = UBound(arr) To 3 Step -2
    
23.             p2 = arr(i - 1, 1)
    
24.             For j = 3 To UBound(arr, 2)
    
25.                 If arr(i, j) <> Empty Then
    
26.                     m = m + 1
    
27.                     brr(m, 1) = dh
    
28.                     brr(m, 2) = p2
    
29.                     brr(m, 3) = arr(i - 1, j)
    
30.                     brr(m, 4) = arr(i, j)
    
31.                 End If
    
32.             Next
    
33.         Next
    
34.     End With
    
35.     With Sheets("提取数据")
    
36.         .[a2:d1000] = ""
    
37.         .[a1].Resize(1, 4).Interior.Color = 49407
    
38.         Set Rng = .[a2].Resize(m, 4)
    
39.         With Rng
    
40.             .Value = brr
    
41.             .Borders.LineStyle = 1
    
42.             .HorizontalAlignment = xlCenter  '//列居中
    
43.             .VerticalAlignment = xlCenter
    
44.         End With
    
45.     End With
    
46.     Application.ScreenUpdating = True
    
47.     MsgBox "OK！"
    
48. End Sub
    

复制代码

zpy2

酉水滔滔 发表于 2024-3-17 20:11
谢谢！不过我水平太浅，您写的这些语句我不知道在哪里运行？

https://club.excelhome.net/forum.php?mod=viewthread&tid=1679471&page=1&mobile&_dsign=772c0d77