提交.清空并存档
'以下程序将实现你的想法,详见附件,还需确定数据库中所有列均与录入表中的列保持一致
Const 录入表清除区 = "B11:Y35"
Const 录入表均温 = "T3"
Sub 提交和清空()
For Each i In Workbooks '检测数据表是否打开
表名 = i。 Name
If 表名 = "数据库。xls" Then
数据表已打开 = 1
Exit For
End If
Next
If 数据表已打开 <> 1 Then '未打开时给出提示
MsgBox "未找到数据库工作簿，请确认该簿是否已打开或簿名是否被更改！"
Exit Sub
End If
Set 录入表 = T...全部
'以下程序将实现你的想法,详见附件,还需确定数据库中所有列均与录入表中的列保持一致
Const 录入表清除区 = "B11:Y35"
Const 录入表均温 = "T3"
Sub 提交和清空()
For Each i In Workbooks '检测数据表是否打开
表名 = i。
Name
If 表名 = "数据库。xls" Then
数据表已打开 = 1
Exit For
End If
Next
If 数据表已打开 <> 1 Then '未打开时给出提示
MsgBox "未找到数据库工作簿，请确认该簿是否已打开或簿名是否被更改！"
Exit Sub
End If
Set 录入表 = ThisWorkbook。
Sheets("基本数据录入")
Set 数据薄 = Workbooks("数据库")
Set 数据表 = 数据薄。Sheets("数据库")
If 数据表。Range("A3") <> 1 Then 数据表。
Range("A3") = 1
数据表。Range("AG1")。Calculate '重新计算已写入行数
写入行 = 数据表。Range("AG1")
For a = 1 To 1000 '容错性检测
If 数据表。
Cells(写入行, 2) = "" And 数据表。Cells(写入行, 3) = "" Then Exit For
If 数据表。Cells(写入行, 2) <> "" And 数据表。
Cells(写入行, 3) <> "" Then
数据表。Cells(写入行 + 1, 1) = 写入行 + 1
写入行 = 写入行 + 1
End If
Next a
For i = 11 To 35 '写入数据 i为行,j为列
数据表。
Cells(写入行, 2) = Date
数据表。Cells(写入行, 3) = Date
数据表。Cells(写入行, 4) = 录入表。Range(录入表均温)
'数据表。Cells(写入行, 5) = "" '日指定用量预留
For j = 1 To 25
If 录入表。
Cells(i, j) <> "" Then 数据表。Cells(写入行, j + 5) = 录入表。Cells(i, j)
Next j
数据表。Cells(写入行 + 1, 1) = 写入行 + 1
写入行 = 写入行 + 1
Next i
录入表。
Range(录入表清除区)。ClearContents '清除单元区域内容
数据薄。Save '保存数据表(可选)
MsgBox "已将数据录入到数据库中！" '完成提示(可选)
End Sub
'有问题请来信:yxb22@ ,祝你开心!。
收起
