新手刚接触vba运行出错求解决办法。

q3698995

Sub 条件去重()
Dim arr, brr, d, i&, s&
Set d = CreateObject("scripting.dictionary")
tj = [b5]: rq = [q5]
arr = Range("b6:e" & Cells(Rows.Count, 5).End(xlUp).Row)
ReDim brr(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
    If arr(i, 1) <> tj And arr(i, 3) <= rq And arr(i, 4) <> "" Then
        If Not d.exists(arr(i, 4)) Then
            s = s + 1
            d(arr(i, 4)) = ""
            brr(s, 1) = arr(i, 4)
        End If
    End If
Next
Range("m6:m300").ClearContents
Range("m6").Resize(s) = brr
msgbox "当brr无符合内容时，这句不执行"
End Sub

MOY838840554

？？？？那句报错？

q3698995

MOY838840554 发表于 2019-1-21 15:14
？？？？那句报错？

就是我把q5单元格的日期改成1时候，条件里的日期没有小于1的情况，然后红色字体那句不执行。

MOY838840554

q3698995 发表于 2019-1-21 15:16
就是我把q5单元格的日期改成1时候，条件里的日期没有小于1的情况，然后红色字体那句不执行。

？？？？brr有没有赋值你判断变量s不就行了。if s>0 then msgbox

q3698995

MOY838840554 发表于 2019-1-21 15:18
？？？？brr有没有赋值你判断变量s不就行了。if s>0 then msgbox

Sub 条件去重()
Dim arr, brr, d, i&, s&
Set d = CreateObject("scripting.dictionary")
tj = [b5]: rq = [q5]
arr = Range("b6:e" & Cells(Rows.Count, 5).End(xlUp).Row)
ReDim brr(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
    If arr(i, 1) <> tj And arr(i, 3) <= rq And arr(i, 4) <> "" Then
        If Not d.exists(arr(i, 4)) Then
            s = s + 1
            d(arr(i, 4)) = ""
            brr(s, 1) = arr(i, 4)
        End If
    End If
Next
ActiveSheet.Unprotect Password:="123"
Range("m6:m300").ClearContents
Range("m6").Resize(s) = brr
ActiveSheet.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=False, UserInterfaceOnly:=False, AllowFormattingCells:=False, AllowFormattingColumns:=False, AllowFormattingRows:=False, AllowInsertingColumns:=False, AllowInsertingRows:=False, AllowInsertingHyperlinks:=False, AllowDeletingColumns:=False, AllowDeletingRows:=False, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=False
End Sub

当所有条件都不符合时，红色区域代码不执行。

q3698995

MOY838840554 发表于 2019-1-21 15:18
？？？？brr有没有赋值你判断变量s不就行了。if s>0 then msgbox

需要brr没有被赋值的情况下运行。

q3698995

MOY838840554 发表于 2019-1-21 15:18
？？？？brr有没有赋值你判断变量s不就行了。if s>0 then msgbox

Sub 条件去重()
Dim arr, brr, d, i&, s&
Set d = CreateObject("scripting.dictionary")
tj = [b5]: rq = [q5]
arr = Range("b6:e" & Cells(Rows.Count, 5).End(xlUp).Row)
ReDim brr(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
    If arr(i, 1) <> tj And arr(i, 3) <= rq And arr(i, 4) <> "" Then
        If Not d.exists(arr(i, 4)) Then
            s = s + 1
            d(arr(i, 4)) = ""
            brr(s, 1) = arr(i, 4)
        End If
    End If
Next
Unprotect Password:="123"
Range("m6:m300").ClearContents
Range("m6").Resize(s) = brr
Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=False, UserInterfaceOnly:=False, AllowFormattingCells:=False, AllowFormattingColumns:=False, AllowFormattingRows:=False, AllowInsertingColumns:=False, AllowInsertingRows:=False, AllowInsertingHyperlinks:=False, AllowDeletingColumns:=False, AllowDeletingRows:=False, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=False
End Sub

当所有条件不满足，也就是brr没有被赋值的情况下，红色字体代码不执行。

lsdongjh

Sub 条件去重()
Dim arr, brr, d, i&, s&
Set d = CreateObject("scripting.dictionary")
tj = [b5]: rq = [q5]
arr = Range("b6:e" & Cells(Rows.Count, 5).End(xlUp).Row)
ReDim brr(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
    If arr(i, 1) <> tj And arr(i, 3) <= rq And arr(i, 4) <> "" Then
        If Not d.exists(arr(i, 4)) Then
            s = s + 1
            d(arr(i, 4)) = ""
            brr(s, 1) = arr(i, 4)
        End If
    End If
Next
if s>0 then

    Unprotect Password:="123"
    Range("m6:m300").ClearContents
    Range("m6").Resize(s) = brr
    Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=False, UserInterfaceOnly:=False, AllowFormattingCells:=False, AllowFormattingColumns:=False, AllowFormattingRows:=False, AllowInsertingColumns:=False, AllowInsertingRows:=False, AllowInsertingHyperlinks:=False, AllowDeletingColumns:=False, AllowDeletingRows:=False, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=False

endif
End Sub

MOY838840554

q3698995 发表于 2019-1-21 15:39
Sub 条件去重()
Dim arr, brr, d, i&, s&
Set d = CreateObject("scripting.dictionary")

说了判断s>0啊