[已解决]I列中用黄色填充的数据进行相加,计算结果填入K列

爷们679

I列中用黄色填充的数据进行相加,计算结果填入K列

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-8-29 11:26

1. Sub aaa()
   
2. Dim arr, brr, i&
   
3. arr = Range("i4:i" & [i65536].End(3).Row)
   
4. ReDim brr(1 To UBound(arr) - 1, 1 To 3)
   
5. For i = 1 To UBound(arr) - 1
   
6.   brr(i, 1) = arr(i, 1) + arr(i + 1, 1)
   
7.   brr(i, 2) = brr(i, 1) - IIf(brr(i, 1) > 16, 16, 0)
   
8.   brr(i, 3) = IIf(brr(i, 2) < 7, brr(i, 2) + 10, "")
   
9. Next i
   
10. [k6].Resize(UBound(brr), 2) = brr
    
11. [n6].Resize(UBound(brr)) = Application.Index(brr, , 3)
    
12. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

1. Sub aaa()
   
2. Dim arr, brr, i&
   
3. arr = Range("i4:i" & [i65536].End(3).Row)
   
4. ReDim brr(1 To UBound(arr) - 1, 1 To 3)
   
5. For i = 1 To UBound(arr) - 1
   
6.   brr(i, 1) = arr(i, 1) + arr(i + 1, 1)
   
7.   brr(i, 2) = brr(i, 1) - IIf(brr(i, 1) > 16, 16, 0)
   
8.   brr(i, 3) = IIf(brr(i, 2) < 7, brr(i, 2) + 10, "")
   
9. Next i
   
10. [k6].Resize(UBound(brr), 2) = brr
    
11. [n6].Resize(UBound(brr)) = Application.Index(brr, , 3)
    
12. End Sub

复制代码

ppp710715

L列在11-16之间的，如何处理？

ppp710715

1. Sub ppp()
   
2. Dim i%, rw%
   
3. [k4:n10000] = ""
   
4. rw = [i655336].End(3).Row
   
5. For i = 5 To rw
   
6.     Range("k" & i + 1) = Cells(i, 9) + Cells(i - 1, 9)
   
7. Next
   
8. For i = 6 To rw + 1
   
9.    If Cells(i, 11) < 17 Then
   
10.    Cells(i, 12) = Cells(i, 11)
    
11.    Else
    
12.    Cells(i, 12) = Cells(i, 11) - 16
    
13.    End If
    
14.    If Cells(i, 12) < 7 Then Cells(i, 14) = Cells(i, 12) + 10
    
15.    If Cells(i, 12) > 6 And Cells(i, 12) < 11 Then Cells(i, 14) = ""
    
16. Next
    
17. MsgBox "计算完毕！"
    
18. End Sub

复制代码

计算.rar (77.46 KB, 下载次数: 2)

2017-8-29 15:56 上传

点击文件名下载附件

idnoidno

我用SELECT CASE

1. <div class="blockcode"><blockquote>Option Explicit
   
2. Sub tw()
   
3. Dim i%, irow%, j%, jrow%
   
4. Range("j:j,l:l,m:m").ClearContents
   
5. irow = [i65536].End(xlUp).Row
   
6. For i = 4 To irow
   
7.     Cells(i + 2, 10) = Cells(i, 9) + Cells(i + 1, 9)
   
8.     Select Case Cells(i + 2, 10)
   
9.         Case Is > 16
   
10.             Cells(i + 2, 12) = Cells(i + 2, 10) - 16
    
11.         Case Is > 0
    
12.             Cells(i + 2, 12) = Cells(i + 2, 10)
    
13.     End Select
    
14. Next i
    
15. 
    
16. jrow = [j65536].End(xlUp).Row
    
17. For j = 6 To jrow
    
18.     Select Case Cells(j, 12)
    
19.         Case Is > 7
    
20.             Cells(j, 13) = ""
    
21.         Case Else
    
22.              Cells(j, 13) = Cells(j, 12)
    
23.     End Select
    
24. Next j
    
25. End Sub
    

复制代码