根据订单号查询，请求指点一下。。。。

葛朋17751999699

大神帮忙看下，代码有哪里不对吗，怎么只能搜索202301002的订单，其他的都无法搜到






Private Sub CommandButton1_Click()
Dim r, i, x, arr, brr()

On Error Resume Next
If IsNumeric(Sheet27.[i3]) = False Or Sheet27.[i3] = "" Then MsgBox "单号错误": Exit Sub
If Sheet27.[c3] = "" Or Sheet27.[e3] = "" Then MsgBox "类型和发货日期不能为空": Exit Sub
    Application.EnableEvents = False
    Application.EnableEvents = True
    With Sheets("国润发货汇总")

     r = .Cells(.Rows.Count, 1).End(3).Row
     arr = .Range("A3:K" & r)
     For i = 3 To UBound(arr)
         If arr(i, 5) = Sheet27.[c3].Value And arr(i, 3) = Sheet27.[e3].Value And arr(i, 2) = Sheet27.[i3] Then
             x = x + 1
             ReDim Preserve brr(1 To UBound(arr), 1 To 4)
             'x = x + 1
             brr(x, 1) = arr(i, 6)
             brr(x, 2) = arr(i, 7)
             brr(x, 3) = arr(i, 8)
             brr(x, 4) = arr(i, 11)
         End If
     Next
    End With
Application.ScreenUpdating = False
Sheet27.[b5:e27].ClearContents
Sheet27.[b5].Resize(UBound(brr), 4) = brr
Application.ScreenUpdating = True
End Sub

zxsea_7426

你这查询不是需要三个条件的吗？同时满足才能查到结果
你可以修改一下，去掉条件，只需要根据订单号，其他无需条件，这样可以出结果

zxsea_7426

修改了一个只根据订单号进行查询的

葛朋17751999699

zxsea_7426 发表于 2023-1-9 07:23
修改了一个只根据订单号进行查询的

感谢帮助，还有就是订单号左边的没有变化

3190496160

1、代码漏洞百出，思路混乱
2、On Error Resume Next容错语句很多时候是陷阱，慎用

3190496160

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim r, i, x, arr, brr()
Dim dh, lx, rq
With Sheet27
    dh = .[i3]
    lx = .[c3]
    rq = .[e3]
    If IsNumeric(dh) = False Or Sheet27.[i3] = "" Then MsgBox "单号错误": Exit Sub
    If lx = "" Or rq = "" Then MsgBox "类型和发货日期不能为空": Exit Sub
    With Sheets("国润发货汇总")
        r = .Cells(.Rows.Count, 1).End(3).Row
        arr = .Range("A3:K" & r)
    End With
    ReDim brr(1 To UBound(arr), 1 To 5)
     For i = 3 To UBound(arr)
        If VBA.Trim(arr(i, 3)) <> "" Then
            If IsDate(arr(i, 3)) Then
                If arr(i, 2) = dh And arr(i, 3) = rq And arr(i, 5) = lx Then
                    x = x + 1
                    brr(x, 1) = x
                    brr(x, 2) = arr(i, 6)
                    brr(x, 3) = arr(i, 7)
                    brr(x, 4) = arr(i, 8)
                    brr(x, 5) = arr(i, 11)
                End If
            End If
         End If
     Next i
    .[a5:e27].ClearContents
    If x = "" Then MsgBox "没有符合条件的数据！": End
    .[a5].Resize(x, UBound(brr, 2)) = brr
End With
Application.ScreenUpdating = True
End Sub

3190496160

订单号查询功能.rar (55.68 KB, 下载次数: 17)

2023-1-9 10:09 上传

点击文件名下载附件

zlzz1971

请用WPS测试。

葛朋17751999699

3190496160 发表于 2023-1-9 10:09
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim r, i, x, arr, brr()

不能用啊

3190496160

葛朋17751999699 发表于 2023-1-9 12:40
不能用啊

哈哈哈，这反馈也是令人醉了