我正在创建一个VBA代码来汇总某个Excel工作表中特定时间间隔内特定单位的值,并在另一张工作表中显示结果

问题描述 投票:0回答:1

在这里,我创建了一个字典来存储所有相同单位(键)的总和的值,然后通过字典中的键值将结果显示在另一张表中。 但求和后字典中的值始终为零,我的代码中缺少什么?

Private Sub btnTonghop_Click()
    Dim wsDulieu As Worksheet
    Dim wsKetqua As Worksheet
    Dim donviDict As Object
    Dim donviRun As Variant
    Dim donvi As Variant
    Dim rng As Range
    Dim cell As Range
    Dim startDate As Date
    Dim endDate As Date
    Dim nextRow As Long
   
    Set wsDulieu = ThisWorkbook.Sheets("BangTonghop")
    Set wsKetqua = ThisWorkbook.Sheets("Timkiem_trichxuat")
    wsKetqua.Rows("6:" & wsKetqua.Rows.count).ClearContents
    Set donviDict = CreateObject("Scripting.Dictionary")
    On Error GoTo ErrorHandler
    startDate = DateValue(txtStartDate.Value)
    endDate = DateValue(txtEndDate.Value)
    On Error GoTo 0
    If endDate < startDate Then
        MsgBox "Ngày ket thúc không duoc truoc ngày bat dau!", vbExclamation
        Exit Sub
    End If

这是给字典添加值

    For currentRow = 2 To wsDulieu.Cells(wsDulieu.Rows.count, 1).End(xlUp).Row
        If wsDulieu.Cells(currentRow, 9).Value >= startDate And wsDulieu.Cells(currentRow, 9).Value <= endDate Then
            donvi = wsDulieu.Cells(currentRow, 2).Value
            If Not donviDict.exists(donvi) Then
                donviDict.Add donvi, Array(0, 0, 0, 0) ' [de nghi cn, de nghi tc, cap cn, cap  tc]
            End If
           
            donviDict(donvi)(0) = donviDict(donvi)(0) + wsDulieu.Cells(currentRow, 5).Value  ' de nghi cn
            donviDict(donvi)(1) = donviDict(donvi)(1) + wsDulieu.Cells(currentRow, 6).Value ' de nghi tc
            donviDict(donvi)(2) = donviDict(donvi)(2) + wsDulieu.Cells(currentRow, 7).Value ' cap cn
            donviDict(donvi)(3) = donviDict(donvi)(3) + wsDulieu.Cells(currentRow, 8).Value ' cap tc
              
        End If
    Next currentRow

将结果写到另一张纸上

    'Ghi ket qua vao bang Timkiem_trichxuat
    wsKetqua.Cells(6, 1).Value = "STT"
    wsKetqua.Cells(6, 2).Value = "Don vi"
    wsKetqua.Cells(6, 3).Value = "De nghi CN"
    wsKetqua.Cells(6, 4).Value = "De nghi TC"
    wsKetqua.Cells(6, 5).Value = "Cap CN"
    wsKetqua.Cells(6, 6).Value = "Cap TC"
    nextRow = 7
    For Each donviRun In donviDict.Keys
        wsKetqua.Cells(nextRow, 1).Value = nextRow - 1 ' STT
        wsKetqua.Cells(nextRow, 2).Value = donviRun ' Ðon vi
        wsKetqua.Cells(nextRow, 3).Value = donviDict(donviRun)(0) ' de nghi cn
        wsKetqua.Cells(nextRow, 4).Value = donviDict(donviRun)(1) 'de nghi tc
        wsKetqua.Cells(nextRow, 5).Value = donviDict(donviRun)(2) ' cap cn
        wsKetqua.Cells(nextRow, 6).Value = donviDict(donviRun)(3) ' cap tc
        nextRow = nextRow + 1
    Next donviRun
    MsgBox "Tong hop du lieu xong!", vbInformation + vbOKOnly, "Xong"
    
ErrorHandler:
    MsgBox "Vui lòng nhap dúng dinh dang ngày (mm/dd/yyyy).", vbExclamation
End Sub 

我尝试检查Excel中的值和字典中的值的数据类型,尝试将两个值转换为相同,但它仍然无法正常工作。

excel vba worksheet scripting.dictionary
1个回答
0
投票

更新字典中的数组(解决方法)

  • 您无法更新字典的item中保存的数组。
  • 这是使用临时数组的解决方法。

快速修复

' This is to populate the dictionary

Dim Arr() As Variant

For currentRow = 2 To wsDulieu.Cells(wsDulieu.Rows.Count, 1).End(xlUp).Row
    
    If wsDulieu.Cells(currentRow, 9).Value >= startDate And wsDulieu.Cells(currentRow, 9).Value <= endDate Then
        
        donvi = wsDulieu.Cells(currentRow, 2).Value
        
        If Not donviDict.exists(donvi) Then
            donviDict.Add donvi, VBA.Array(0, 0, 0, 0) ' [de nghi cn, de nghi tc, cap cn, cap  tc]
        End If
        
        Arr = donviDict(donvi)
        
        Arr(0) = Arr(0) + wsDulieu.Cells(currentRow, 5).Value  ' de nghi cn
        Arr(1) = Arr(1) + wsDulieu.Cells(currentRow, 6).Value ' de nghi tc
        Arr(2) = Arr(2) + wsDulieu.Cells(currentRow, 7).Value ' cap cn
        Arr(3) = Arr(3) + wsDulieu.Cells(currentRow, 8).Value ' cap tc
          
        donviDict(donvi) = Arr
          
    End If

Next currentRow
© www.soinside.com 2019 - 2024. All rights reserved.