求助大神用切西瓜的思路解决桩号分段问题

sunya_0529

WPS里的JSA练习一下——

rysxing

jsa，比较笨的方法，试试。。。。。。

micch

A星星啊 发表于 2024-9-22 19:23
您好，为什么在600的位置会重复计算呢

没重复啊？

cidanji

1. Sub ss()
   
2. Dim ar, i&, n&, a, b, x, y, d As Object
   
3. Set d = CreateObject("scripting.dictionary")
   
4. ar = Range("A1:C" & Cells(Rows.Count, 1).End(3).Row)
   
5. For i = 2 To UBound(ar)
   
6.     a = ar(i, 1): b = ar(i, 2)
   
7.     Do
   
8.         x = (a \ 100) * 100
   
9.         y = IIf(x + 100 >= b, b, x + 100)
   
10.         n = n + 1: d(n) = Array(a, y, ar(i, 3))
    
11.         a = y
    
12.     Loop While a < b
    
13. Next
    
14. Range("E2:G" & Rows.Count).ClearContents
    
15. If d.Count Then Range("E2").Resize(d.Count, 3) = Application.Rept(d.items, 1)
    
16. End Sub

复制代码

一招秒杀

仅 1句4行，完美解决。

一招秒杀

cnmlgb9998 发表于 2024-9-22 19:09
用PQ 解决！

仅 1句6行，0.04秒+， 我觉得这个也很简单很快。

tcdatongye

micch

1. =LET(a,MIN(A:A),b,MAX(B:B),c,UNIQUE(SORT(VSTACK(TOCOL(A2:A15),b,SEQUENCE(INT((b-a)/100+1),,INT(a%+1)*100,100)))),DROP(REDUCE(0,c,LAMBDA(x,y,IF(y>=b,x,VSTACK(x,HSTACK(y,MIN(b,y+100),IFERROR(VLOOKUP(y,A2:C15,3),"")))))),1))

复制代码

公式一串