[已解决]求修改一个宏，谢谢，有图 有附件

kidd1217

Sub 求和()
Dim i, k

k = Range("b65536").End(xlUp).Row

For i = Range("b65536").End(xlUp).Row To 1 Step -1

    If Cells(i, "t") = "" Then

        Cells(i, "t") = "=sum(t" & i + 1 & ":t" & k & ")"

        k = i - 1

    End If

Next
End Sub

上面的宏中的 t  想用inputbox 输入进去，我设置了半天没成功,望老手帮忙

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-1-6 09:40

1. Sub 求和()
   
2.     Dim i, k, col$
   
3.     k = Range("b65536").End(xlUp).Row
   
4.     col = Application.InputBox("请输入列名[英文字母]:", , , , , , , 2)
   
5.     On Error Resume Next
   
6.     If Len(Cells(1, col).Address) = 0 Then MsgBox "列标错误，请重来": Err.Clear: Exit Sub
   
7.     Application.ScreenUpdating = False
   
8.     For i = Range("b65536").End(xlUp).Row To 1 Step -1
   
9.         If Cells(i, col) = "" Then
   
10.             Cells(i, col) = "=sum(" & col & i + 1 & ":" & col & k & ")"
    
11.             k = i - 1
    
12.         End If
    
13.     Next
    
14.     Application.ScreenUpdating = True
    
15. End Sub

复制代码

跳转到最佳答案楼层

zhoucs00

你的意思是不是说求某一列，这里就是求T列。在这一列中的空格内填上，前面连续的非空的和？我是这样理解的，我重新写了段代码。

1. Sub zhoucs00()
   
2. Dim k As Integer, t As Integer, rng As Range, rg As Range
   
3. k = Range("b65536").End(xlUp).Row + 1
   
4. t = Application.InputBox("请输入数字", , , , , , , 1)
   
5. Set rg = Cells(1, t)
   
6. For Each rng In Range(Cells(1, t), Cells(k, t))
   
7.     If Len(rng) = 0 Then
   
8.         rng = Application.WorksheetFunction.Sum(Range(rg.Address, rng.Offset(-1, 0)))
   
9.         Set rg = rng.Offset(1, 0)
   
10.     End If
    
11. Next rng
    
12. End Sub
    

复制代码

图纸材料统计表-0106.rar (65 KB, 下载次数: 0)

2013-1-6 09:27 上传

点击文件名下载附件

hwc2ycy

1. Sub 求和()
   
2.     Dim i, k, col$
   
3.     k = Range("b65536").End(xlUp).Row
   
4.     col = Application.InputBox("请输入列名[英文字母]:", , , , , , , 2)
   
5.     On Error Resume Next
   
6.     If Len(Cells(1, col).Address) = 0 Then MsgBox "列标错误，请重来": Err.Clear: Exit Sub
   
7.     For i = Range("b65536").End(xlUp).Row To 1 Step -1
   
8.         If Cells(i, col) = "" Then
   
9.             Cells(i, col) = "=sum(" & col & i + 1 & ":" & col & k & ")"
   
10.             k = i - 1
    
11.         End If
    
12.     Next
    
13. End Sub

复制代码

hwc2ycy

得加个关闭刷屏的代码才行，刷得太厉害了。

hwc2ycy

1. Sub 求和()
   
2.     Dim i, k, col$
   
3.     k = Range("b65536").End(xlUp).Row
   
4.     col = Application.InputBox("请输入列名[英文字母]:", , , , , , , 2)
   
5.     On Error Resume Next
   
6.     If Len(Cells(1, col).Address) = 0 Then MsgBox "列标错误，请重来": Err.Clear: Exit Sub
   
7.     Application.ScreenUpdating = False
   
8.     For i = Range("b65536").End(xlUp).Row To 1 Step -1
   
9.         If Cells(i, col) = "" Then
   
10.             Cells(i, col) = "=sum(" & col & i + 1 & ":" & col & k & ")"
    
11.             k = i - 1
    
12.         End If
    
13.     Next
    
14.     Application.ScreenUpdating = True
    
15. End Sub

复制代码

zhoucs00

楼主，我给你写的代码，能满足你的条件不？回个话呀。至少让我心里也有个底。。。。

kidd1217

zhoucs00 发表于 2013-1-6 10:46
楼主，我给你写的代码，能满足你的条件不？回个话呀。至少让我心里也有个底。。。。

sorry
可以满足的

谢谢了

您费心了！！

zhoucs00

kidd1217 发表于 2013-1-6 12:28
sorry
可以满足的

那就好。呵呵