下标越界 哪位老师能帮看看要哪里做判断

wangadao

Private Sub CommandButton1_Click()
    If TextBox1.Text = "" Then MsgBox "请输入客户名称!", , "提示": Exit Sub
    If ComboBox1.Value = "" Or ComboBox2.Value = "" Then MsgBox "请输入日期!", , "提示": Exit Sub
    Dim arr, crr(), iDate1 As Date, iDate2 As Date, x%, i%, y%
    arr = Sheet1.UsedRange
    iDate1 = ComboBox1.Value
    iDate2 = ComboBox2.Value
   If iDate2 < iDate1 Then MsgBox "结束日期不能大于或等于开始日期!", , "提示": Exit Sub
    For x = 2 To UBound(arr)
        If arr(x, 1) >= iDate1 And arr(x, 1) <= iDate2 And TextBox1.Value = arr(x, 2) Then
            i = i + 1
            ReDim Preserve crr(1 To UBound(arr, 2), 0 To i)
            For y = 1 To UBound(arr, 2)
                crr(y, i) = arr(x, y)
            Next y
           ' Else: MsgBox "123!", , "提示": Exit Sub
        End If
        'If x = 1 And y = 0 Then MsgBox "没有这个客户!", , "提示": Exit Sub
    Next x
     'If x = 1 Then MsgBox "没有这个客户!", , "提示": Exit Sub
    For x = 1 To UBound(arr, 2)
        crr(x, 0) = arr(1, x)
    Next x
    With Sheet2
        .Cells.ClearContents
        .Cells.Borders.LineStyle = 0
        .Range("A1").Resize(UBound(crr, 2) + 1, UBound(crr)) = Application.Transpose(crr)
        .Range("A1").Resize(UBound(crr, 2) + 1, UBound(crr)).Borders.LineStyle = 1
    End With
    Erase arr, crr
    MsgBox "查找完毕！"
End Sub

--------------------------------------
TextBox1 的值在 列B里没有  就提示报错  想不出在哪做判断中断。哪位老师能帮帮我。

笑着...两年过去

1. Private Sub CommandButton1_Click()
   
2.     If TextBox1.Text = "" Then MsgBox "请输入客户名称!", , "提示": Exit Sub
   
3.     If ComboBox1.Value = "" Or ComboBox2.Value = "" Then MsgBox "请输入日期!", , "提示": Exit Sub
   
4.     Dim arr, crr(), iDate1 As Date, iDate2 As Date, x%, i%, y%
   
5.     arr = Sheet1.UsedRange
   
6.     iDate1 = ComboBox1.Value
   
7.     iDate2 = ComboBox2.Value
   
8.    If iDate2 < iDate1 Then MsgBox "结束日期不能大于或等于开始日期!", , "提示": Exit Sub
   
9.     For x = 2 To UBound(arr)
   
10.         If arr(x, 1) >= iDate1 And arr(x, 1) <= iDate2 And TextBox1.Value = arr(x, 2) Then
    
11.             i = i + 1
    
12.             ReDim Preserve crr(1 To UBound(arr, 2), 0 To i)
    
13.             For y = 1 To UBound(arr, 2)
    
14.                 crr(y, i) = arr(x, y)
    
15.             Next y
    
16.            ' Else: MsgBox "123!", , "提示": Exit Sub
    
17.         End If
    
18.         'If x = 1 And y = 0 Then MsgBox "没有这个客户!", , "提示": Exit Sub
    
19.     Next x
    
20.      If i = 0 Then MsgBox "没有这个客户!", , "提示": Exit Sub
    
21.     For x = 1 To UBound(arr, 2)
    
22.         crr(x, 0) = arr(1, x)
    
23.     Next x
    
24.     With Sheet2
    
25.         .Cells.ClearContents
    
26.         .Cells.Borders.LineStyle = 0
    
27.         .Range("A1").Resize(UBound(crr, 2) + 1, UBound(crr)) = Application.Transpose(crr)
    
28.         .Range("A1").Resize(UBound(crr, 2) + 1, UBound(crr)).Borders.LineStyle = 1
    
29.     End With
    
30.     Erase arr, crr
    
31.     MsgBox "查找完毕！"
    
32. End Sub

复制代码