<think>我们面临一个复杂的任务:在生成“卫星节目故障统计表”后,再创建一个“卫星节目汇总分析表”,并按照特定规则进行汇总分析。
步骤分解:
0. 在“卫星节目汇总分析表”第一行合并A1:G1,复制“卫星节目故障统计表”第一行的内容(即源工作表第一行的内容),加粗显示。
1. 在第二行创建标题行:[影响卫星]、[影响节目]、[发生日期]、[发生时间]、[结束时间]、[持续时间(秒)]、[故障类型],并加粗。
2. 汇总分析逻辑(核心):
- 数据源:来自“卫星节目故障统计表”的数据(从第3行开始,因为第1行是合并标题,第2行是列标题)。
- 按“影响节目”列分组(相同节目名称的分为一组)。
- 对于每个节目组,再按“发生时间”的日期部分(年-月-日)分组。
- 在同一个日期组内,再按时间(时:分:秒)进行聚类,规则是:秒数相差在±2秒以内的时间视为相同时间点(注意:这里我们只比较秒,且允许±2秒的误差,但实际中可能同一秒内发生多次,所以我们需要将时间转换为秒数,然后比较差值是否<=2)。
- 对于相同时间点(或秒数相差±2以内)的多个记录,进行如下处理:
a. 如果这些记录的持续时间(秒)相同,则将这些记录合并为一行(合并操作实际上是将这些记录中除故障类型外的其他字段合并(因为其他字段应该相同?)?但问题要求:将相同时间点的多行数据列单元格合并居中,然后将合并后的单元格数据赋值到汇总表。注意:这里要求合并,但实际中,影响卫星、节目、发生时间(日期部分相同,时间部分我们认为是相同的)、结束时间(可能不同?)等,如何处理?
b. 但是问题描述中要求:比较持续时间的大小,取最大的。而且故障类型要单独汇总(即合并故障类型?)。所以这里存在歧义,我们需要重新理解需求。
重新理解需求(针对相同节目、相同日期、时间相差±2秒内的多条记录):
1. 首先,我们把这些记录分为一组(时间相近组)。
2. 然后,比较这些记录的持续时间(秒),取最大值所在的那条记录作为代表(注意:这里要求取持续时间最大的那条记录的数据,但故障类型要单独汇总,即把所有记录的故障类型合并起来?)。
3. 但是,问题描述中还有一句:“若相同则将拥有相同<时:分:秒>或<时:分:'秒±2以内'>所在多行的数据进行列单元格合并居中处理”,这里可能是指将多行合并成一行,然后每个字段都显示合并后的信息?但后面又说“其余参与数字大小比较的行数据进行舍弃”,所以实际上我们只保留一条记录(持续时间最大的那条),但故障类型要汇总(即把多条记录的故障类型合并成一个字符串,用逗号隔开?)。
具体操作:
- 对于同一个时间相近组:
a. 找出持续时间最大的那条记录(如果持续时间相同,则取第一条?)。
b. 用这条记录的数据作为基础,但故障类型字段需要将这个组内所有记录的故障类型合并(去重?或者不去重?问题没有明确,这里我们不去重,用逗号连接)。
- 如果组内只有一条记录,则直接使用。
3. 对于不同时间(即不在±2秒内)的记录,则各自作为一条记录。
4. 此外,在汇总表中,我们还需要将“发生时间”拆分成两列:“发生日期”(只有年-月-日)和“发生时间”(时:分:秒)。
5. 最后,在汇总表中,对于同一个节目的同一个日期,可能有多条记录(不同时间点),然后我们还要对“发生日期”列进行合并居中(即同一个日期的多行合并成一个单元格,显示日期)。
步骤实现:
由于VBA处理这种复杂分组和聚合比较繁琐,我们将使用以下方法:
1. 将“卫星节目故障统计表”的数据读取到数组中。
2. 构建字典进行多级分组:第一级键是节目名称,第二级键是日期(年-月-日),第三级键是时间(以秒为单位,然后按±2秒的误差进行聚类)。
3. 对于第三级分组,我们遍历每个时间相近组,进行聚合(取持续时间最大的记录,并合并故障类型)。
4. 将聚合后的数据输出到“卫星节目汇总分析表”中。
5. 最后,对“发生日期”列进行合并居中。
注意:时间聚类算法:将时间转换为从0点开始的秒数,然后对每个时间点,我们寻找在已有聚类中是否有在±2秒内的,如果有则归入该组,否则新建一个组。
由于需求复杂,代码较长,我们将分步骤实现。
我们假设“卫星节目故障统计表”的结构如下(从第3行开始是数据):
A列:影响卫星
B列:影响节目
C列:发生时间(日期时间格式)
D列:结束时间(日期时间格式)
E列:持续时间(秒,数字)
F列:故障类型(字符串)
在“卫星节目汇总分析表”中,我们将输出:
A列:影响卫星(取代表记录的卫星)
B列:影响节目(节目名称)
C列:发生日期(从发生时间中提取的日期部分,格式为年-月-日)
D列:发生时间(从发生时间中提取的时间部分,格式为时:分:秒)
E列:结束时间(代表记录的结束时间)
F列:持续时间(代表记录的持续时间)
G列:故障类型(该时间相近组内所有记录的故障类型合并,用逗号分隔)
步骤:
1. 创建“卫星节目汇总分析表”并设置标题。
2. 从“卫星节目故障统计表”中读取数据到数组。
3. 使用多级字典进行分组:
第一级:节目名称(字符串)
第二级:日期(字符串,格式为"yyyy-mm-dd")
第三级:时间聚类(我们用一个列表来存储同一个聚类内的所有行索引,以及该聚类的代表时间(秒数))
4. 构建聚类的方法:
遍历每个节目的同一天内的所有记录,将每条记录的发生时间转换为秒数(从0点开始的总秒数)。
然后,对于每一条记录,与已有的聚类比较(每个聚类有一个代表时间,即该聚类中第一条记录的时间秒数),如果当前记录的时间秒数与某个聚类代表时间相差在±2秒内,则加入该聚类;否则新建一个聚类。
5. 对于每个聚类,进行聚合:
- 找出该聚类中持续时间最长的记录(如果有多个相同的最大值,取第一条)。
- 记录该条记录的信息(卫星、节目、发生时间、结束时间、持续时间),并将聚类中所有记录的故障类型合并(用逗号连接)。
- 注意:发生时间我们取聚类代表时间(即第一条记录的时间)?还是取最大持续时间记录的时间?这里我们取最大持续时间记录的发生时间(包括日期和时间),因为代表记录是那条记录。
6. 将聚合后的数据写入新工作表,同时拆分发生时间为日期和时间两列。
7. 最后,对汇总表的“发生日期”列进行合并居中(即同一日期的多行合并)。
由于代码较长,我们将逐步实现。
注意:由于数据量可能很大,我们使用数组操作以提高效率。
代码实现如下:</think>我将为您实现新增的汇总分析功能。以下是完整的VBA代码解决方案:
```vba
Sub GenerateSatelliteProgramReportV5()
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Dim srcSheet As Worksheet, statSheet As Worksheet, analysisSheet As Worksheet
Set srcSheet = ThisWorkbook.Sheets("告警记录")
' 创建卫星节目故障统计表
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Sheets("卫星节目故障统计表").Delete
ThisWorkbook.Sheets("卫星节目汇总分析表").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Set statSheet = ThisWorkbook.Sheets.Add(After:=srcSheet)
statSheet.Name = "卫星节目故障统计表"
' ==== 统计表表头 ====
Dim srcHeader As String
srcHeader = srcSheet.Range("A1").Value
' 统计表合并标题
With statSheet.Range("A1:F1")
.Merge
.Value = srcHeader
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
' 统计表标题行
statSheet.Range("A2:F2") = Array("影响卫星", "影响节目", "发生时间", "结束时间", "持续时间(秒)", "故障类型")
statSheet.Rows(2).Font.Bold = True
Dim lastRow As Long, statRow As Long
lastRow = srcSheet.Cells(srcSheet.Rows.Count, "C").End(xlUp).Row
statRow = 3
' 处理数据并填充统计表
Dim dataRow As Range, signalCell As Range
For Each dataRow In srcSheet.Range("C3:C" & lastRow).Rows
Set signalCell = dataRow.Cells(1, 1)
Dim signalStr As String, satellite As String, programStr As String
signalStr = CStr(signalCell.Value)
' 信号解析
Dim lastUnderscorePos As Long
lastUnderscorePos = InStrRev(signalStr, "_")
If lastUnderscorePos = 0 Then GoTo NextRow
satellite = Mid(signalStr, lastUnderscorePos + 1)
programStr = Left(signalStr, lastUnderscorePos - 1)
Dim programs() As String
programs = Split(programStr, "/")
' 获取关联数据
Dim occurTime As Date, resumeTime As Date, faultType As String
occurTime = signalCell.Offset(0, 3).Value ' F列
resumeTime = signalCell.Offset(0, 4).Value ' G列
faultType = signalCell.Offset(0, 2).Value ' E列
Dim durationSeconds As Long
durationSeconds = ConvertDurationToSeconds(signalCell.Offset(0, 5).Value) ' H列
' 写入每个节目
Dim i As Integer
For i = 0 To UBound(programs)
statSheet.Cells(statRow, 1) = satellite
statSheet.Cells(statRow, 2) = programs(i)
statSheet.Cells(statRow, 3) = occurTime
statSheet.Cells(statRow, 4) = resumeTime
statSheet.Cells(statRow, 5) = durationSeconds
statSheet.Cells(statRow, 6) = faultType
statRow = statRow + 1
Next i
NextRow:
Next dataRow
' 统计表排序与格式设置
If statRow > 3 Then
With statSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=statSheet.Range("C3:C" & statRow - 1), Order:=xlDescending
.SortFields.Add Key:=statSheet.Range("B3:B" & statRow - 1), Order:=xlAscending
.SetRange statSheet.Range("A3:F" & statRow - 1)
.Header = xlNo
.Apply
End With
statSheet.Range("C3:D" & statRow - 1).NumberFormat = "yyyy-mm-dd hh:mm:ss"
statSheet.Range("E3:E" & statRow - 1).NumberFormat = "0"
statSheet.Columns("A:F").AutoFit
statSheet.Range("A1").HorizontalAlignment = xlCenter
statSheet.Range("A2:F2").HorizontalAlignment = xlCenter
statSheet.Range("A3:F" & statRow - 1).HorizontalAlignment = xlCenter
End If
' ==== 创建卫星节目汇总分析表 ====
Set analysisSheet = ThisWorkbook.Sheets.Add(After:=statSheet)
analysisSheet.Name = "卫星节目汇总分析表"
' 功能0:分析表表头
With analysisSheet.Range("A1:G1")
.Merge
.Value = srcHeader
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
' 功能1:分析表标题行
analysisSheet.Range("A2:G2") = Array("影响卫星", "影响节目", "发生日期", "发生时间", "结束时间", "持续时间(秒)", "故障类型")
analysisSheet.Rows(2).Font.Bold = True
analysisSheet.Range("A2:G2").HorizontalAlignment = xlCenter
' 功能2:汇总分析处理
If statRow <= 3 Then
MsgBox "统计表中无数据,跳过汇总分析"
GoTo Finalize
End If
Dim analysisRow As Long: analysisRow = 3
Dim programDict As Object: Set programDict = CreateObject("Scripting.Dictionary")
' 按节目名称分组
Dim r As Long
For r = 3 To statRow - 1
Dim programName As String
programName = statSheet.Cells(r, 2).Value
If Not programDict.Exists(programName) Then
programDict.Add programName, New Collection
End If
programDict(programName).Add r
Next r
' 处理每个节目的数据
Dim programKey As Variant, dateDict As Object, dateKey As String
Dim timeDict As Object, timeKey As String
Dim timeCluster As Object, clusterKey As String
Dim maxDurationRow As Long, maxDuration As Long
Dim faultTypes As Object
For Each programKey In programDict.Keys
Set dateDict = CreateObject("Scripting.Dictionary")
' 按日期分组
For Each r In programDict(programKey)
Dim occurDate As String
occurDate = Format(statSheet.Cells(r, 3).Value, "yyyy-mm-dd")
If Not dateDict.Exists(occurDate) Then
dateDict.Add occurDate, New Collection
End If
dateDict(occurDate).Add r
Next r
' 处理每个日期的数据
For Each dateKey In dateDict.Keys
Set timeDict = CreateObject("Scripting.Dictionary")
Set faultTypes = CreateObject("Scripting.Dictionary")
' 按时间聚类分组(秒数±2秒内视为同一时间点)
For Each r In dateDict(dateKey)
Dim occurTimeValue As Date
occurTimeValue = statSheet.Cells(r, 3).Value
' 转换为秒数(从0点开始的秒数)
Dim totalSeconds As Long
totalSeconds = Hour(occurTimeValue) * 3600 + Minute(occurTimeValue) * 60 + Second(occurTimeValue)
' 查找匹配的时间聚类
Dim clusterFound As Boolean: clusterFound = False
Dim existingCluster As Variant
For Each existingCluster In timeDict.Keys
If Abs(existingCluster - totalSeconds) <= 2 Then
timeDict(existingCluster).Add r
clusterFound = True
Exit For
End If
Next existingCluster
' 如果没有匹配的聚类,创建新的
If Not clusterFound Then
timeDict.Add totalSeconds, New Collection
timeDict(totalSeconds).Add r
End If
Next r
' 处理每个时间聚类
For Each timeKey In timeDict.Keys
Dim clusterRows As Collection
Set clusterRows = timeDict(timeKey)
' 如果只有一行,直接使用
If clusterRows.Count = 1 Then
r = clusterRows(1)
analysisSheet.Cells(analysisRow, 1) = statSheet.Cells(r, 1).Value
analysisSheet.Cells(analysisRow, 2) = programKey
analysisSheet.Cells(analysisRow, 3) = dateKey
analysisSheet.Cells(analysisRow, 4) = Format(statSheet.Cells(r, 3).Value, "hh:mm:ss")
analysisSheet.Cells(analysisRow, 5) = statSheet.Cells(r, 4).Value
analysisSheet.Cells(analysisRow, 6) = statSheet.Cells(r, 5).Value
analysisSheet.Cells(analysisRow, 7) = statSheet.Cells(r, 6).Value
analysisRow = analysisRow + 1
Else
' 查找持续时间最长的记录
maxDuration = 0
maxDurationRow = 0
Dim faultTypeStr As String: faultTypeStr = ""
For Each r In clusterRows
Dim currentDuration As Long
currentDuration = statSheet.Cells(r, 5).Value
If currentDuration > maxDuration Then
maxDuration = currentDuration
maxDurationRow = r
End If
' 收集故障类型
Dim currentFaultType As String
currentFaultType = statSheet.Cells(r, 6).Value
If Not faultTypes.Exists(currentFaultType) Then
faultTypes.Add currentFaultType, currentFaultType
If faultTypeStr = "" Then
faultTypeStr = currentFaultType
Else
faultTypeStr = faultTypeStr & "、" & currentFaultType
End If
End If
Next r
' 使用持续时间最长的记录作为代表
analysisSheet.Cells(analysisRow, 1) = statSheet.Cells(maxDurationRow, 1).Value
analysisSheet.Cells(analysisRow, 2) = programKey
analysisSheet.Cells(analysisRow, 3) = dateKey
analysisSheet.Cells(analysisRow, 4) = Format(statSheet.Cells(maxDurationRow, 3).Value, "hh:mm:ss")
analysisSheet.Cells(analysisRow, 5) = statSheet.Cells(maxDurationRow, 4).Value
analysisSheet.Cells(analysisRow, 6) = maxDuration
analysisSheet.Cells(analysisRow, 7) = faultTypeStr
analysisRow = analysisRow + 1
End If
Next timeKey
Next dateKey
Next programKey
' 功能3:合并相同发生日期的单元格
If analysisRow > 3 Then
Dim currentDate As String, startRow As Long, endRow As Long
currentDate = analysisSheet.Cells(3, 3).Value
startRow = 3
For r = 3 To analysisRow - 1
If analysisSheet.Cells(r, 3).Value <> currentDate Or r = analysisRow - 1 Then
endRow = IIf(r = analysisRow - 1, r, r - 1)
If endRow > startRow Then
With analysisSheet.Range("C" & startRow & ":C" & endRow)
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End If
currentDate = analysisSheet.Cells(r, 3).Value
startRow = r
End If
Next r
' 设置格式
analysisSheet.Columns("C").NumberFormat = "yyyy-mm-dd"
analysisSheet.Columns("D").NumberFormat = "hh:mm:ss"
analysisSheet.Columns("E").NumberFormat = "yyyy-mm-dd hh:mm:ss"
analysisSheet.Columns("F").NumberFormat = "0"
' 自动调整列宽
analysisSheet.Columns("A:G").AutoFit
analysisSheet.Range("A3:G" & analysisRow - 1).HorizontalAlignment = xlCenter
End If
Finalize:
MsgBox "生成完成!统计表处理 " & statRow - 3 & " 条记录,分析表生成 " & analysisRow - 3 & " 条记录。"
Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
MsgBox "错误 " & Err.Number & ": " & Err.Description, vbCritical, "运行时错误"
Application.ScreenUpdating = True
End Sub
Function ConvertDurationToSeconds(durationStr As String) As Long
On Error Resume Next
Dim t As Date
t = TimeValue(durationStr)
If Err.Number = 0 Then
ConvertDurationToSeconds = Hour(t) * 3600 + Minute(t) * 60 + Second(t)
Else
ConvertDurationToSeconds = 0
End If
End Function
```
### 代码功能说明:
1. **创建汇总分析表**:
- 在统计表后新建"卫星节目汇总分析表"
- 合并A1:G1单元格并复制标题
- 创建第二行标题:影响卫星、影响节目、发生日期、发生时间、结束时间、持续时间(秒)、故障类型
2. **数据分组与聚类**:
- 使用字典对象按节目名称分组
- 对每个节目按日期分组(年-月-日)
- 对同一天内的时间进行聚类(秒数±2秒内视为同一时间点)
3. **时间聚类处理**:
```vba
' 按时间聚类分组(秒数±2秒内视为同一时间点)
For Each r In dateDict(dateKey)
' 转换为秒数(从0点开始的秒数)
totalSeconds = Hour(occurTimeValue) * 3600 + Minute(occurTimeValue) * 60 + Second(occurTimeValue)
' 查找匹配的时间聚类
For Each existingCluster In timeDict.Keys
If Abs(existingCluster - totalSeconds) <= 2 Then
timeDict(existingCluster).Add r
clusterFound = True
Exit For
End If
Next
Next
```
4. **聚类数据处理逻辑**:
- 单条记录:直接复制到分析表
- 多条记录:
* 找出持续时间最长的记录
* 合并所有故障类型(去重后用"、"连接)
* 使用最长持续时间的记录作为代表数据
5. **日期合并功能**:
```vba
' 合并相同发生日期的单元格
For r = 3 To analysisRow - 1
If analysisSheet.Cells(r, 3).Value <> currentDate Or r = analysisRow - 1 Then
' 合并日期单元格
With analysisSheet.Range("C" & startRow & ":C" & endRow)
.Merge
.HorizontalAlignment = xlCenter
End With
End If
Next
```
6. **格式设置**:
- 发生日期:yyyy-mm-dd格式
- 发生时间:hh:mm:ss格式
- 结束时间:yyyy-mm-dd hh:mm:ss格式
- 自动调整列宽和居中对齐
### 使用注意事项:
1. 时间聚类精度为±2秒,可根据需要调整
2. 故障类型合并时会自动去重
3. 日期合并只对连续相同日期的行有效
4. 如果统计表无数据,会跳过分析表创建