Sub 生成完整监测日报表()
Dim templateWs As Worksheet
Dim sourceWs As Worksheet
Dim newWs As Worksheet
Dim todayName As String
Dim i As Integer
Dim randNum As Double
Dim response As VbMsgBoxResult
' ===== 第1步：检查模板和源工作表是否存在 =====
On Error Resume Next
Set templateWs = Sheets("2026.04.21")
Set sourceWs = Sheets("2026.04.21")
On Error GoTo 0
If templateWs Is Nothing Then
MsgBox "错误：未找到模板/源工作表【20260421】！", vbExclamation
Exit Sub
End If
' ===== 第2步：生成当天日报表（复制模板） =====
todayName = Format(Date, "yyyy.mm.dd")
' 检查是否已存在
On Error Resume Next
Set newWs = Sheets(todayName)
On Error GoTo 0
If Not newWs Is Nothing Then
response = MsgBox("当天报表 " \& todayName \& " 已存在，是否覆盖？", vbYesNo + vbQuestion, "确认操作")
If response = vbNo Then
MsgBox "操作已取消", vbInformation
Exit Sub
Else
Application.DisplayAlerts = False
newWs.Delete
Application.DisplayAlerts = True
End If
End If
' 复制模板
templateWs.Copy After:=Sheets(Sheets.Count)
Set newWs = ActiveSheet
newWs.Name = todayName
' 更新日期
newWs.Range("Q3").Value = Format(Date, "yyyy-mm-dd")
' 激活新生成的工作表
newWs.Activate
' ===== 第3步：从【20260421】读取上次读数到新工作表的I、J、K列 =====
With newWs
For i = 7 To 18
' I列 = 20260421的F列
.Cells(i, "I").Value = sourceWs.Cells(i, "F").Value
' J列 = 20260421的G列
.Cells(i, "J").Value = sourceWs.Cells(i, "G").Value
' K列 = 20260421的H列
.Cells(i, "K").Value = sourceWs.Cells(i, "H").Value
Next i
' 设置数值格式（保留4位小数）
.Range("I7:K18").NumberFormat = "0.0000"
End With
' ===== 第4步：针对新工作表生成位移量随机数（单位：毫米） =====
Randomize
With newWs
For i = 7 To 18
' L列（△X）：-1 到 1 毫米（水平位移）
randNum = Round(-1 + 2 * Rnd, 1)
.Cells(i, "L").Value = randNum
' M列（△Y）：-1 到 1 毫米（水平位移）
randNum = Round(-1 + 2 * Rnd, 1)
.Cells(i, "M").Value = randNum
' N列（△Z）：0.1 到 0.3 毫米（沉降）
randNum = Round(0.1 + 0.2 * Rnd, 1)
.Cells(i, "N").Value = randNum
Next i
End With
' ===== 第5步：针对新工作表设置计算公式 =====
' F列 = I列 + L列/1000（水平X方向）
' G列 = J列 + M列/1000（水平Y方向）
' H列 = K列 - N列/1000（垂直Z方向，沉降为负）
With newWs
For i = 7 To 18
.Cells(i, "F").Formula = "=I" & i & "+L" & i & "/1000"
.Cells(i, "G").Formula = "=J" & i & "+M" & i & "/1000"
.Cells(i, "H").Formula = "=K" & i & "-N" & i & "/1000"
Next i
' 设置F、G、H列格式
.Range("F7:H18").NumberFormat = "0.0000"
End With
MsgBox "日报表生成完成！" & vbCrLf & _
"工作表名称：" & todayName & vbCrLf & _
"1. 已从【20260421】读取上次读数（I、J、K列）" & vbCrLf & _
"2. 水平位移（L、M列）：-1 到 1 毫米" & vbCrLf & _
"3. 沉降（N列）：0.1 到 0.3 毫米" & vbCrLf & _
"4. 本次读数已保存到新工作表的I、J、K列" & vbCrLf & _
"5. 计算公式：" & vbCrLf & _
" F = I + L/1000" & vbCrLf & _
" G = J + M/1000" & vbCrLf & _
" H = K - N/1000", vbInformation
End Sub