[已解决]间距差

mmc998

Book间距差.zip (251.84 KB, 下载次数: 25)

2014-12-31 06:49 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

ppp710715

2014-12-31 10:33

1. Sub ppp()
   
2.   Dim arr, brr, crr, drr(1 To 4), err(1 To 3), frr(1 To 2), grr(1 To 10000), i&, rn&
   
3.   rn = Cells(Rows.Count, 2).End(3).Row
   
4.   arr = Range("b3:g" & rn)
   
5.   k = UBound(arr)
   
6.   ReDim brr(1 To 5, 1 To k)
   
7.   For i = 1 To UBound(arr)
   
8.     brr(1, i) = arr(i, 2) - arr(i, 1)
   
9.     brr(2, i) = arr(i, 3) - arr(i, 2)
   
10.     brr(3, i) = arr(i, 4) - arr(i, 3)
    
11.     brr(4, i) = arr(i, 5) - arr(i, 4)
    
12.     brr(5, i) = arr(i, 6) - arr(i, 5)
    
13.      crr = Application.Index(brr, 0, i)
    
14.      drr(1) = Application.Large(crr, 1) - Application.Large(crr, 2)
    
15.      drr(2) = Application.Large(crr, 2) - Application.Large(crr, 3)
    
16.      drr(3) = Application.Large(crr, 3) - Application.Large(crr, 4)
    
17.      drr(4) = Application.Large(crr, 4) - Application.Large(crr, 5)
    
18.      
    
19.      err(1) = Application.Large(drr, 1) - Application.Large(drr, 2)
    
20.      err(2) = Application.Large(drr, 2) - Application.Large(drr, 3)
    
21.      err(3) = Application.Large(drr, 3) - Application.Large(drr, 4)
    
22.      
    
23.      frr(1) = Application.Large(err, 1) - Application.Large(err, 2)
    
24.      frr(2) = Application.Large(err, 2) - Application.Large(err, 3)
    
25.      
    
26.      n = n + 1
    
27.      'ReDim Preserve grr(1 To 1, 1 To n)
    
28.      
    
29.      grr(i) = Application.Large(frr, 1) - Application.Large(frr, 2)
    
30.      Erase crr
    
31.   Next
    
32.   Range("ah3:ah" & rn).Clear
    
33.   [ah3].Resize(rn - 2) = Application.Transpose(grr)
    
34. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. [ag3] = "=ABS(AE3-AF3)"
   
3. Range("ag3:ag" & Range("a65536").End(xlUp).Row).FillDown
   
4. End Sub

复制代码

ppp710715

1. Sub ppp()
   
2.   Dim arr, brr, crr, drr(1 To 4), err(1 To 3), frr(1 To 2), grr(1 To 10000), i&, rn&
   
3.   rn = Cells(Rows.Count, 2).End(3).Row
   
4.   arr = Range("b3:g" & rn)
   
5.   k = UBound(arr)
   
6.   ReDim brr(1 To 5, 1 To k)
   
7.   For i = 1 To UBound(arr)
   
8.     brr(1, i) = arr(i, 2) - arr(i, 1)
   
9.     brr(2, i) = arr(i, 3) - arr(i, 2)
   
10.     brr(3, i) = arr(i, 4) - arr(i, 3)
    
11.     brr(4, i) = arr(i, 5) - arr(i, 4)
    
12.     brr(5, i) = arr(i, 6) - arr(i, 5)
    
13.      crr = Application.Index(brr, 0, i)
    
14.      drr(1) = Application.Large(crr, 1) - Application.Large(crr, 2)
    
15.      drr(2) = Application.Large(crr, 2) - Application.Large(crr, 3)
    
16.      drr(3) = Application.Large(crr, 3) - Application.Large(crr, 4)
    
17.      drr(4) = Application.Large(crr, 4) - Application.Large(crr, 5)
    
18.      
    
19.      err(1) = Application.Large(drr, 1) - Application.Large(drr, 2)
    
20.      err(2) = Application.Large(drr, 2) - Application.Large(drr, 3)
    
21.      err(3) = Application.Large(drr, 3) - Application.Large(drr, 4)
    
22.      
    
23.      frr(1) = Application.Large(err, 1) - Application.Large(err, 2)
    
24.      frr(2) = Application.Large(err, 2) - Application.Large(err, 3)
    
25.      
    
26.      n = n + 1
    
27.      'ReDim Preserve grr(1 To 1, 1 To n)
    
28.      
    
29.      grr(i) = Application.Large(frr, 1) - Application.Large(frr, 2)
    
30.      Erase crr
    
31.   Next
    
32.   Range("ah3:ah" & rn).Clear
    
33.   [ah3].Resize(rn - 2) = Application.Transpose(grr)
    
34. End Sub

复制代码