[已解决]求助：类型不匹配

wgxfhi11

ubb3cfcV.rar (33.1 KB, 下载次数: 0)

2010-1-11 16:14 上传

点击文件名下载附件
求助：类型不匹配

最佳答案

月排行榜 / 总排行榜

amulee

2010-1-12 08:43

这样就好了

Sub ff()
Dim arDt As Variant
Dim arRe() As Variant
Dim oDic As Object
Dim daSta As Date
Dim daStp As Date
Dim bDate As Boolean
Dim iDct As Integer
Dim iTmp As Integer
Dim i As Integer
Range("A2:D177").ClearContents
arDt = Sheet1.Range("a3").CurrentRegion
ReDim arRe(1 To UBound(arDt), 1 To 4)
daSta = Range("f3").Value
daStp = Range("h3").Value
Set oDic = CreateObject("scripting.dictionary")
For i = 4 To UBound(arDt)
    If Len(arDt(i, 1)) = 0 Then Exit For
    bDate = (DateValue(arDt(i, 1)) >= daSta) And (DateValue(arDt(i, 1)) <= daStp)
    If bDate Then
        iTmp = oDic(arDt(i, 3) & arDt(i, 4))
        If iTmp = 0 Then
            iDct = iDct + 1
            oDic(arDt(i, 3) & arDt(i, 4)) = iDct
            iTmp = iDct
        End If
         arRe(iTmp, 1) = iTmp
         arRe(iTmp, 2) = arDt(i, 3)
         arRe(iTmp, 3) = arDt(i, 4)
         arRe(iTmp, 4) = arRe(iTmp, 4) + arDt(i, 5)
   End If
Next
[a2].Resize(iDct, 4) = arRe
End Sub

跳转到最佳答案楼层

雨狐

因为ardt数据有空，在判断日期时提示不匹配，改为红的部份试试

Sub ff()
Dim arDt As Variant
Dim arRe() As Variant
Dim oDic As Object
Dim daSta As Date
Dim daStp As Date
Dim bDate As Boolean
Dim iDct As Integer
Dim iTmp As Integer
Dim i As Integer
Range("A2:D177").ClearContents
With Sheet1
    arDt = .Range("a3:f" & .[a65536].End(3).Row)
End With
'arDt = Sheet1.Range("a3").CurrentRegion
ReDim arRe(1 To UBound(arDt), 1 To 4)
daSta = Range("f3").Value
daStp = Range("h3").Value
Set oDic = CreateObject("scripting.dictionary")
For i = 4 To UBound(arDt)
    bDate = (DateValue(arDt(i, 1)) >= daSta) And (DateValue(arDt(i, 1)) <= daStp)
    If bDate Then
        iTmp = oDic(arDt(i, 3) & arDt(i, 4))
        If iTmp = 0 Then
            iDct = iDct + 1
            oDic(arDt(i, 3) & arDt(i, 4)) = iDct
            iTmp = iDct
        End If
         arRe(iTmp, 1) = iTmp
         arRe(iTmp, 2) = arDt(i, 3)
         arRe(iTmp, 3) = arDt(i, 4)
         arRe(iTmp, 4) = arRe(iTmp, 4) + arDt(i, 5)
   End If
Next
[a2].Resize(iDct, 4) = arRe
End Sub

戏子

CurrentRegion不能用于设置保护的工作表，会产生N多空数据

wgxfhi11

QUOTE:

以下是引用雨狐在2010-1-11 18:09:00的发言：

因为ardt数据有空，在判断日期时提示不匹配，改为红的部份试试

Sub ff()
Dim arDt As Variant
Dim arRe() As Variant
Dim oDic As Object
Dim daSta As Date
Dim daStp As Date
Dim bDate As Boolean
Dim iDct As Integer
Dim iTmp As Integer
Dim i As Integer
Range("A2:D177").ClearContents
With Sheet1
    arDt = .Range("a3:f" & .[a65536].End(3).Row)
End With
'arDt = Sheet1.Range("a3").CurrentRegion
ReDim arRe(1 To UBound(arDt), 1 To 4)
daSta = Range("f3").Value
daStp = Range("h3").Value
Set oDic = CreateObject("scripting.dictionary")
For i = 4 To UBound(arDt)
    bDate = (DateValue(arDt(i, 1)) >= daSta) And (DateValue(arDt(i, 1)) <= daStp)
    If bDate Then
        iTmp = oDic(arDt(i, 3) & arDt(i, 4))
        If iTmp = 0 Then
            iDct = iDct + 1
            oDic(arDt(i, 3) & arDt(i, 4)) = iDct
            iTmp = iDct
        End If
         arRe(iTmp, 1) = iTmp
         arRe(iTmp, 2) = arDt(i, 3)
         arRe(iTmp, 3) = arDt(i, 4)
         arRe(iTmp, 4) = arRe(iTmp, 4) + arDt(i, 5)
   End If
Next
[a2].Resize(iDct, 4) = arRe
End Sub

你好，我按你的方式改了，可是还是出现了类型不匹配，请帮忙查看一下，谢谢!

amulee

这样就好了

Sub ff()
Dim arDt As Variant
Dim arRe() As Variant
Dim oDic As Object
Dim daSta As Date
Dim daStp As Date
Dim bDate As Boolean
Dim iDct As Integer
Dim iTmp As Integer
Dim i As Integer
Range("A2:D177").ClearContents
arDt = Sheet1.Range("a3").CurrentRegion
ReDim arRe(1 To UBound(arDt), 1 To 4)
daSta = Range("f3").Value
daStp = Range("h3").Value
Set oDic = CreateObject("scripting.dictionary")
For i = 4 To UBound(arDt)
    If Len(arDt(i, 1)) = 0 Then Exit For
    bDate = (DateValue(arDt(i, 1)) >= daSta) And (DateValue(arDt(i, 1)) <= daStp)
    If bDate Then
        iTmp = oDic(arDt(i, 3) & arDt(i, 4))
        If iTmp = 0 Then
            iDct = iDct + 1
            oDic(arDt(i, 3) & arDt(i, 4)) = iDct
            iTmp = iDct
        End If
         arRe(iTmp, 1) = iTmp
         arRe(iTmp, 2) = arDt(i, 3)
         arRe(iTmp, 3) = arDt(i, 4)
         arRe(iTmp, 4) = arRe(iTmp, 4) + arDt(i, 5)
   End If
Next
[a2].Resize(iDct, 4) = arRe
End Sub