夜间找茬，为何出现好多000000000

shibaideren

出现了好多0，怎么去掉？ 求解

quqiyuan

代码如下。。。。
Sub testAA()


    Dim arr, brr
    Dim dic As Object
    Set dic = CreateObject("scripting.dictionary")

    ' 读取W2:DJ144区域的数据
    arr = Range("W2:DJ144").Value

    ' 初始化brr数组，这里先不定义第二维度的大小
    ReDim brr(1 To UBound(arr), 1 To 1)

    Dim ss As String
    Dim x As Long, y As Long
    Dim colIndex As Integer
   
    ' 遍历每一列（从左到右）
    For y = 1 To UBound(arr, 2)
        ss = Format(arr(1, y), "yyyy-mm-dd")
        If ss <> Empty Then
            ' 如果字典中不存在这个日期，则添加它，并设置新的列索引
            If Not dic.exists(ss) Then
                colIndex = dic.Count + 1
                dic.Add ss, colIndex
               
                ' 动态调整brr数组大小以适应新增加的列
                If colIndex > UBound(brr, 2) Then
                    ReDim Preserve brr(1 To UBound(arr), 1 To colIndex)
                End If
               
                ' 设置标题行
                brr(1, colIndex) = arr(1, y)
               
                ' 复制该列下的所有数据
                For x = 2 To UBound(arr)
                    ' 只有当是数值时才复制，否则保持为空
                    If IsNumeric(arr(x, y)) Then
                        brr(x, colIndex) = arr(x, y)
                    Else
                        brr(x, colIndex) = ""
                    End If
                Next x
               
            Else
                ' 如果字典中已存在该日期，则只对数值进行累加
                colIndex = dic(ss)
                For x = 2 To UBound(arr)
                    ' 确保我们只对数值类型进行累加，否则保留原样
                    If IsNumeric(arr(x, y)) And IsNumeric(brr(x, colIndex)) Then
                        brr(x, colIndex) = brr(x, colIndex) + arr(x, y)
                    ElseIf IsNumeric(arr(x, y)) Then
                        ' 如果当前单元格是数值但目标位置不是，则直接赋值
                        brr(x, colIndex) = arr(x, y)
                    End If
                Next x
            End If
        End If
    Next y

    ' 清除原有区域的内容
    Range("W2:DJ144").ClearContents

    ' 将结果写回到W2:DJ144
    Range("W2").Resize(UBound(brr), UBound(brr, 2)).Value = brr
    Range("W2:DJ144").Select
End Sub

quqiyuan

参与一下，仅供参考。。。

shibaideren

quqiyuan 发表于 2025-1-2 22:45
代码如下。。。。
Sub testAA()

感谢老师，祝，老师！多子多孙多长寿！！！