41651ba8bbe77cffecb6ef54d560d77.png
vba在使用字典将日期和其他字段拼接后作为主键，再获取之后，涉及将拼接主键重新拆分成日期和其他字段，那么这时拆分后的日期会变成字符串形式。
image.png
实际上日期字段作为一个重要信息，后续还有其他操作的话就涉及将字符串字段重新转换成日期格式。
image.png
由于日期读取时含有星期几，不符合字符串转日期格式的条件，所以先采用文本函数取出字符串日期格式，然后再转成日期格式后，读到新的数组或者写入到单元格中。
image.png
Sub saleamount()
Dim arr
Dim uniqueArr() As Variant
Dim i As Long, j As Long, n As Long
Dim d As Object
Worksheets("发货明细汇总").Range("A5:ag63356").Borders.LineStyle = xlNone
Worksheets("发货明细汇总").Range("A5:c63356").Clear
icount = Worksheets("年成品日出入明细表").[a63356].End(xlUp).Row
arr = Worksheets("年成品日出入明细表").Range("a2:o" & icount)
' 初始化数组和字典
Set d = CreateObject("scripting.Dictionary")
' 使用字典找出不重复的订单号、产品和日期
For i = 1 To UBound(arr)
If arr(i, 2) <> "合计：" And arr(i, 2) <> "总计：" _
And arr(i, 14) <> 0 _
Then
d(arr(i, 1) & "|" & arr(i, 3)) = d(arr(i, 1) & "|" & arr(i, 3)) + arr(i, 14) '组合成键值
End If
Next i
ReDim uniqueArr(1 To d.Count, 1 To 3)
j = 1 '新数组的索引
For Each Key In d.keys
arrkey = Split(Key, "|") '分割键值得到订单号、产品和日期
uniqueArr(j, 1) = CDate(Left(arrkey(0), InStr(arrkey(0), " ") - 1)) '日期
uniqueArr(j, 2) = arrkey(1) '客户名称
uniqueArr(j, 3) = d(Key) '发货
j = j + 1
Next Key
For n = 1 To UBound(uniqueArr)
Worksheets("发货明细汇总").Cells(n + 4, "A").Value = uniqueArr(n, 1)
Worksheets("发货明细汇总").Cells(n + 4, "b") = uniqueArr(n, 2)
Worksheets("发货明细汇总").Cells(n + 4, "c") = uniqueArr(n, 3)
Next
'表格区域绘制框线
ncount = [a63356].End(xlUp).Row
Worksheets("发货明细汇总").Range("A5:ag" & ncount).Borders.LineStyle = xlContinuous
For k = 1 To UBound(uniqueArr)
'检查日期是否在指定时间段内
If Cells(k + 4, 1) >= [c1] And Cells(k + 4, 1) <= [f1] Then
'如果日期在指定时间段内，则保留该行数据，否则将其隐藏
Rows(k + 4).Hidden = False
Else
Rows(k + 4).Hidden = True
End If
Next k
'Range("A5:AG" & ncount).Sort Key1:=Range("B4"), Order1:=xlAscending
End Sub
