Private Sub CommandButton1_Click() '''不定条件个数查询
Dim ar As Variant
Dim br(), cr()
With Sheets("PMC")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 3 Then MsgBox "数据源为空！": End
ar = .Range(.Cells(2, 1), .Cells(r, 24))
End With
rr = Array(TextBox1.Text, 9, TextBox2.Text, 8, ComboBox2.Text, 12, ComboBox1.Text, 21, TextBox7.Text, 2, TextBox8.Text, 2)
ks = TextBox7.Text
js = TextBox8.Text
xyz = ComboBox1.Text
ReDim br(1 To 6, 1 To 2)
For i = 0 To UBound(rr) Step 2
If Trim(rr(i)) <> Empty Then
n = n + 1
br(n, 1) = rr(i)
br(n, 2) = rr(i + 1)
End If
Next i
If n = "" Then MsgBox "请至少输入一个查询条件！": Exit Sub
ReDim cr(1 To UBound(ar), 1 To UBound(ar, 2))
k = 1
For j = 1 To UBound(ar, 2)
cr(k, j) = ar(1, j)
Next j
For i = 2 To UBound(ar)
m = 0
If ks <> "" Or js <> "" Then
If Trim(ar(i, 2)) <> "" Then
If IsDate(ar(i, 2)) Then
rq = CDate(Format(ar(i, 2), "yyyy/m/d"))
If ks <> "" Then
If rq >= ks Then
m = m + 1
End If
End If
If js <> "" Then
If rq <= js Then
m = m + 1
End If
End If
End If
End If
End If
For s = 1 To n
zd = br(s, 1)
lh = br(s, 2)
If lh <> 2 Then
If Trim(ar(i, lh)) = Trim(zd) Then
m = m + 1
End If
End If
Next s
If m = n Then
k = k + 1
For j = 1 To UBound(ar, 2)
cr(k, j) = ar(i, j)
Next j
End If
Next i
If k = 1 Then MsgBox "没有符合条件的数据！", vbDefaultButton1, "【系统】-提示": Exit Sub
If xyz <> "" Then
For i = 2 To k
For s = i + 1 To k
If cr(i, 24) < cr(s, 24) Then
For j = 1 To UBound(cr, 2)
kk = cr(i, j)
cr(i, j) = cr(s, j)
cr(s, j) = kk
Next j
End If
Next s
Next i
End If
With listbox1
.Clear
.ColumnCount = 24
.TextAlign = 2
.List = cr
.ColumnWidths = "50;100;50;25;60;70;50;40;60;80;50;50;50;50;50;50;50;70;50;50;40" '设置数据字段宽度
End With
End Sub
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-1-14 19:05
