背小猫捉蜻蜓
发表于 2022-1-29 21:43:49
大神,我打开了,不一样的啊
温斯特
发表于 2022-1-30 15:02:39
已经设置好公式,信息表我已经添加到总表里,总表的一些信息我删除了,你再复制进去就可以,按户号,可以查询出其他信息,表已经重新修改
总表-重新修改.rar
名字有点甜
发表于 2022-1-30 22:46:22
如果只是信息查询还行,格式化太费工夫了
幸福的潜水艇
发表于 2022-2-3 22:16:27
根据名字获取户号查询,如果名字有同名会提示
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