|
|
各位大佬，求助一下，这个程序为什么不起作用
需求是
1、按照Devition List中A列和Statistical Table中B列文件名的对应关系
2、根据Statistical Table的第6行C列开始的数据
3、统计Devition List中D列的数据
效果图如下：
代码如下
Sub CountUniqueData()
Dim wb As Workbook
Dim wsDev As Worksheet, wsCode As Worksheet
Dim lastRowDev As Long, lastRowCode As Long, lastColumn As Long
Dim devRange As Range, codeRange As Range
Dim devDict As Object
Dim devValue As String, codeValue As String
Dim uniqueCount As Long
Dim i As Long, j As Long, k As Long
Dim countNonEmpty As Long, countNonEmpty1 As Long
Dim DLValue As String, DMValue As String
Dim DLTValue As String, DMTValue As String
Set wb = ThisWorkbook
' 设置Devition List和Statistical Table的工作表
Set wsDev = wb.Sheets("Devition List") ' 修改为实际的工作表名称
Set wsCode = wb.Sheets("Statistical Table") ' 修改为实际的工作表名称
' 确定Devition List最后一个非空单元格的行号
lastRowDev = wsDev.Cells(wsDev.Rows.Count, "A").End(xlUp).Row
' 定义数据范围，表示从 A 列的第 5 行到 lastRowDev 行，以及 D 列的第 5 行到 lastRowDev 行的范围
Set devRange = wsDev.Range("A5:A" & lastRowDev & ", D5:D" & lastRowDev)
' 获取Statistical Table中B列倒数第四个非空单元格的行号
lastRowCode = wsCode.Cells(wsCode.Rows.Count, "B").End(xlUp).Row
countNonEmpty = 0
For i = lastRowCode To 1 Step -1
If Not IsEmpty(wsCode.Cells(i, "B").Value) Then
countNonEmpty = countNonEmpty + 1
If countNonEmpty = 4 Then
lastRowCode = i
Exit For
End If
End If
Next i
' 获取Statistical Table中第6行的倒数第3列列号
lastColumn = wsCode.Cells(6, wsCode.Columns.Count).End(xlToLeft).Column
countNonEmpty1 = 0
For j = lastColumn To 1 Step -1
If Not IsEmpty(wsCode.Cells(6, j).Value) Then
countNonEmpty1 = countNonEmpty1 + 1
If countNonEmpty1 = 3 Then
lastColumn = j
Exit For
End If
End If
Next j
' Union 函数用于组合多个不相邻的范围成一个单独的范围对象
' wsCode.Range("B8:B" & lastRowCode) 表示B列的第8行到 lastRowCode 行的范围。
' wsCode.Range(wsCode.Cells(6, 5), wsCode.Cells(6, lastColumn)) 表示第6行的第5列到 lastColumn 列的范围。
Set codeRange = Union(wsCode.Range("B8:B" & lastRowCode), wsCode.Range(wsCode.Cells(6, 5), wsCode.Cells(6, lastColumn)))
' 使用字典来存储每个A列和D列组合的唯一值
Set devDict = CreateObject("Scripting.Dictionary")
' 遍历Devition List中的每一行，构建字典（A列和D列组合）
For i = 5 To lastRowDev
devValue = wsDev.Cells(i, "A").Value & "|" & wsDev.Cells(i, "D").Value
If Not devDict.exists(devValue) Then
devDict(devValue) = 0
End If
Next i
' 遍历Statistical Table中的每一行，计算符合条件的唯一组合数量
For i = 8 To lastRowCode
For j = 5 To lastColumn
codeValue = wsCode.Cells(i, "B").Value & "|" & wsCode.Cells(6, j).Value
If devDict.exists(codeValue) Then
devDict(codeValue) = devDict(codeValue) + 1
End If
Next j
Next i
' 将结果写入Statistical Table中
For i = 5 To lastRowDev 'Devition List A列从5行开始到非空行的最后一行
For j = 8 To lastRowCode 'Statistical Table B列第8行开始到倒数第4行
devValue = wsDev.Cells(i, "A").Value & "|" & wsDev.Cells(i, "D").Value
If devDict.exists(devValue) Then
DLValue = wsDev.Cells(j, "A").Value
DMValue = wsCode.Cells(i, "B").Value
If DLValue = DMValue Then
DLTValue = wsDev.Cells(j, "D").Value
For k = 3 To lastColumn 'Statistical Table中第6行第三列到倒数第三列
DMTValue = wsCode.Cells(6, k).Value
If DLTValue = DMTValue Then
wsCode.Cells(j, k).Value = devDict(devValue)
' Exit For ' 只需要找到一次匹配即可，可以选择退出内层循环
End If
Next k
End If
End If
Next j
Next i
' 清除对象引用
Set devDict = Nothing
Set codeRange = Nothing
Set devRange = Nothing
Set wsCode = Nothing
Set wsDev = Nothing
Set wb = Nothing
MsgBox "统计完成！", vbInformation
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-7-5 13:20
楼主