|
|
根据名字获取户号查询，如果名字有同名会提示
Sub test()
Dim i&, arr, j%
Dim krr
Dim n%
Dim brr(1 To 100, 1 To 11)
Dim fh, na
With Sheet1
.Cells(5, 1).Resize(9, UBound(brr, 2)).ClearContents
fh = Trim(.Cells(2, 4).Value)
na = Trim(.Cells(2, 2).Value)
End With
If fh = "" And na = "" Then Exit Sub
krr = Array(2, 15, 18, 14, 23, 26, 20, 21, 22, 19, 24)
With Sheet5
i = .Cells(.Cells.Rows.Count, 7).End(3).Row
arr = .Cells(1, 1).Resize(i, 27)
End With
If fh = "" And na <> "" Then
For i = 1 To UBound(arr)
If Trim(arr(i, 2)) = na And arr(i, 13) = "是" Then
n = n + 1
fh = Trim(arr(i, 7))
End If
Next i
If n > 1 Then
MsgBox "共有" & n & "个名字，请用户号查询"
Exit Sub
ElseIf n < 1 Then
MsgBox "没有查询到该名字,请从新输入"
Exit Sub
End If
End If
With Sheet1
n = 0
For i = 1 To UBound(arr)
If Trim(arr(i, 7)) = fh Then
n = n + 1
For j = 0 To UBound(krr)
brr(n, j + 1) = arr(i, krr(j))
Next j
brr(n, 3) = Mid(brr(n, 10), 7, 8)
If arr(i, 13) = "是" Then
.Cells(2, 2) = arr(i, 2)
.Cells(2, 4) = arr(i, 7)
.Cells(2, 6) = arr(i, 6)
.Cells(2, 9) = arr(i, 27)
.Cells(2, 11) = arr(i, 16)
.Cells(3, 2) = arr(i, 8)
.Cells(3, 4) = arr(i, 9)
.Cells(3, 6) = arr(i, 10)
.Cells(3, 9) = arr(i, 11)
.Cells(3, 11) = arr(i, 12)
End If
End If
Next i
If n > 0 Then
If n < 9 Then
.Cells(5, 1).Resize(9, UBound(brr, 2)) = brr
Else
MsgBox "共有" & n & "人,已超过9人请确认"
End If
Else
MsgBox "没有该户号的，请从新输入"
End If
End With
End Sub |
|
