...另从上次相加结束的单元格起(逐个相加为一定值时
发布网友
发布时间：2024-10-06 04:06
共1个回答
热心网友
时间：2024-10-11 11:49
Private Sub Command1_Click()
Dim xls As Excel.Application
Dim xlbook As Excel.Workbook
On Error GoTo exlError
Dim i As Integer
Dim lngValue As Long
Dim intStep As Integer
Const THE_VALUE = 50 '一定值
If Dir(App.Path & "\test.xls") <> "" Then '此目录下如有同名文件给出提示,并作相应处理
If MsgBox("文件已存在，是否覆盖！", vbYesNo + vbQuestion, "另存为工程造价文件") = vbNo Then
Exit Sub
Else
Kill (App.Path & "\test.xls") '删除文件
End If
End If
'************打开工作表***************
Set xls = New Excel.Application
xls.Visible = True
Set xlbook = xls.Workbooks.Add
'****************************工作表初使化***********************************
Dim xlsheet As Excel.Worksheet
Set xlsheet = xlbook.Sheets(1) '第一张工作表
xlsheet.Columns("a:j").Font.Size = 10
xlsheet.Columns("a:j").HorizontalAlignment = xlHAlignRight
Dim xlsum As Excel.Worksheet
Set xlsum = xlbook.Sheets(2) '第二张工作表
'***************************写入内容*************************
i = 1 'i控制列
For j = 1 To 30
xlsheet.Cells(j, i) = j '写入随机数
Next
'判断部分-------------------------------------------------
i = 1 'i控制列
intStep = 1
For j = 1 To 30
lngValue = lngValue + Val(xlsheet.Cells(j, i))
If lngValue >= THE_VALUE Then
xlsum.Cells(intStep, 1) = lngValue
intStep = intStep + 1
lngValue = 0
End If
Next
'--------------------------------------------------
xlbook.SaveAs App.Path & "\test.xls" '保存EXCEL文件
'***************************关闭EXCEL对象*******************
Set xlbook = Nothing
Set xls = Nothing
Exit Sub
exlError:
MsgBox Err.Description, vbOKOnly + vbCritical, "警告"
End Sub
