阙辉

4、查询脚本设计

Sub chaxun1()
Select Case Sheets("查询表").Range("d1").Value
Case Is = "结算业绩表"
jiesuanchaxun1
Case Is = "上数业绩表"
shanngshuchaxun1
Case Is = "费用明细表"
feiyongchaxun1
'Case Is = "调整项"
'Sheets("查询表").Range("a1").Value = 4
End Select
End Sub
Sub jiesuanchaxun1()
t = Timer
Dim arr2(1 To 3000, 1 To 30)
Dim h, w, y, l, aa, asfb, bsfb As Long

Sheets("查询表").[b4:ad100000].Clear
Application.ScreenUpdating = False

With Sheets("查询表")
.Range("b2:b100000").NumberFormatLocal = "yyyy-m-d"
.Range("c2:c100000").NumberFormatLocal = "@"
.Range("e:e").NumberFormatLocal = "@"
.Range("f:f").NumberFormatLocal = "@"
.Range("g:g").NumberFormatLocal = "@"
.Range("h:h").NumberFormatLocal = "@"
.Range("i:i").NumberFormatLocal = "@"
.Range("j:j").NumberFormatLocal = "@"
.Range("k:k").NumberFormatLocal = "@"
.Range("l:l").NumberFormatLocal = "@"
.Range("m:m").NumberFormatLocal = "@"
.Range("n:n").NumberFormatLocal = "#,##0.00_ ;[红色]-#,##0.00 "
.Range("o:o").NumberFormatLocal = "yyyy-m-d"
.Range("p:p").NumberFormatLocal = "yyyy-m-d"
.Range("q:q").NumberFormatLocal = "#,##0.00_ ;[红色]-#,##0.00 "
.Range("r:r").NumberFormatLocal = "0.00%"
.Range("s:s").NumberFormatLocal = "#,##0.00_ ;[红色]-#,##0.00 "
.Range("t:t").NumberFormatLocal = "#,##0.00_ ;[红色]-#,##0.00 "
.Range("u:u").NumberFormatLocal = "#,##0.00_ ;[红色]-#,##0.00 "
.Range("v:v").NumberFormatLocal = "#,##0.00_ ;[红色]-#,##0.00 "
.Range("w:w").NumberFormatLocal = "#,##0.00_ ;[红色]-#,##0.00 "
.Range("x:x").NumberFormatLocal = "#,##0.00_ ;[红色]-#,##0.00 "
.Range("y:y").NumberFormatLocal = "@"
.Range("z:z").NumberFormatLocal = "@"
.Range("aa:aa").NumberFormatLocal = "@"
.Range("ab:ab").NumberFormatLocal = "@"
.Range("ac:ac").NumberFormatLocal = "@"
.Range("ad:ad").NumberFormatLocal = "@"
.Range("ae:ae").NumberFormatLocal = "yyyy-m-d"
End With

aa = Sheets("结算业绩表").Range("a1048576").End(xlUp).Row
Range("a2") = aa
'ReDim arr2(1 To 3000, 1 To 30)
arr = Sheets("结算业绩表").Range("a2:ad" & aa)
'arr = Sheets("结算业绩表").Range("a2", Cells(Rows.Count, "ad").End(xlUp))
l = UBound(arr)
For i = 1 To l
If arr(i, 2) = Sheets("查询表").Range("c1").Value And arr(i, 1) = Sheets("查询表").Range("b1").Value Then
n = n + 1
'Sheets("查询表").Cells(n + 2, "b").Resize(1, 30) = WorksheetFunction.Index(arr, i, 0) '不使用数组
arr2(n, 1) = arr(i, 1)
arr2(n, 2) = arr(i, 2)
arr2(n, 3) = arr(i, 3)
arr2(n, 4) = arr(i, 4)
arr2(n, 5) = n
arr2(n, 6) = arr(i, 6)
arr2(n, 7) = arr(i, 7)
arr2(n, 8) = arr(i, 8)
arr2(n, 9) = arr(i, 9)
arr2(n, 10) = arr(i, 10)
arr2(n, 11) = arr(i, 11)
arr2(n, 12) = arr(i, 12)
arr2(n, 13) = arr(i, 13)
arr2(n, 14) = arr(i, 14)
arr2(n, 15) = arr(i, 15)
arr2(n, 16) = arr(i, 16)
arr2(n, 17) = arr(i, 17)
arr2(n, 18) = arr(i, 18)
arr2(n, 19) = arr(i, 19)
arr2(n, 20) = arr(i, 20)
arr2(n, 21) = arr(i, 21)
arr2(n, 22) = arr(i, 22)
arr2(n, 23) = arr(i, 23)
arr2(n, 24) = arr(i, 24)
arr2(n, 25) = arr(i, 25)
arr2(n, 26) = arr(i, 26)
arr2(n, 27) = arr(i, 27)
arr2(n, 28) = arr(i, 28)
arr2(n, 29) = arr(i, 29)
arr2(n, 30) = arr(i, 30)
End If
w = UserForm1.Label3.Width
UserForm1.Show 0
h = h + w / l
UserForm1.Label2.Width = h
UserForm1.Label1 = "已完成" & Format(i / l, "0.00%")
UserForm1.Caption = "正在运行，已耗时" & Format(Timer - t, "0.00") & "秒，请稍后！！！"
DoEvents
Next
Sheets("查询表").Range("b4:ae3000") = arr2
Erase arr2
asfb = Sheets("查询表").Range("d100000").End(xlUp).Row
'bsfb = ws.Range("iv" & 2).End(xlToLeft).Column
With Range("b3:ae" & asfb) '设置打印边框 7
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
End With
Range("3:100000").RowHeight = 16
Application.ScreenUpdating = ture
Unload UserForm1
MsgBox Timer - t
End Sub
Sub shanngshuchaxun1()
t = Timer
Dim arr2(1 To 3000, 1 To 30)
Dim h, w, y, l, aa, asfb, bsfb As Long

Sheets("查询表").[b4:ad100000].Clear
Application.ScreenUpdating = False

With Sheets("查询表")
.Range("b2:b100000").NumberFormatLocal = "yyyy-m-d"
.Range("c2:c100000").NumberFormatLocal = "@"
.Range("e:e").NumberFormatLocal = "@"
.Range("f:f").NumberFormatLocal = "@"
.Range("g:g").NumberFormatLocal = "@"
.Range("h:h").NumberFormatLocal = "@"
.Range("i:i").NumberFormatLocal = "@"
.Range("j:j").NumberFormatLocal = "@"
.Range("k:k").NumberFormatLocal = "@"
.Range("l:l").NumberFormatLocal = "@"
.Range("m:m").NumberFormatLocal = "@"
.Range("n:n").NumberFormatLocal = "#,##0.00_ ;[红色]-#,##0.00 "
.Range("o:o").NumberFormatLocal = "yyyy-m-d"
.Range("p:p").NumberFormatLocal = "yyyy-m-d"
.Range("q:q").NumberFormatLocal = "#,##0.00_ ;[红色]-#,##0.00 "
.Range("r:r").NumberFormatLocal = "0.00%"
.Range("s:s").NumberFormatLocal = "#,##0.00_ ;[红色]-#,##0.00 "
.Range("t:t").NumberFormatLocal = "#,##0.00_ ;[红色]-#,##0.00 "
.Range("u:u").NumberFormatLocal = "#,##0.00_ ;[红色]-#,##0.00 "
.Range("v:v").NumberFormatLocal = "#,##0.00_ ;[红色]-#,##0.00 "
.Range("w:w").NumberFormatLocal = "#,##0.00_ ;[红色]-#,##0.00 "
.Range("x:x").NumberFormatLocal = "#,##0.00_ ;[红色]-#,##0.00 "
.Range("y:y").NumberFormatLocal = "@"
.Range("z:z").NumberFormatLocal = "@"
.Range("aa:aa").NumberFormatLocal = "@"
.Range("ab:ab").NumberFormatLocal = "@"
.Range("ac:ac").NumberFormatLocal = "@"
.Range("ad:ad").NumberFormatLocal = "@"
.Range("ae:ae").NumberFormatLocal = "yyyy-m-d"
End With

aa = Sheets("上数业绩表").Range("a1048576").End(xlUp).Row
Range("a2") = aa
'ReDim arr2(1 To 3000, 1 To 30)
arr = Sheets("上数业绩表").Range("a2:ad" & aa)
'arr = Sheets("结算业绩表").Range("a2", Cells(Rows.Count, "ad").End(xlUp))
l = UBound(arr)
For i = 1 To l
If arr(i, 2) = Sheets("查询表").Range("c1").Value And arr(i, 1) = Sheets("查询表").Range("b1").Value Then
n = n + 1
'Sheets("查询表").Cells(n + 2, "b").Resize(1, 30) = WorksheetFunction.Index(arr, i, 0)
arr2(n, 1) = arr(i, 1)
arr2(n, 2) = arr(i, 2)
arr2(n, 3) = arr(i, 3)
arr2(n, 4) = arr(i, 4)
arr2(n, 5) = n
arr2(n, 6) = arr(i, 6)
arr2(n, 7) = arr(i, 7)
arr2(n, 8) = arr(i, 8)
arr2(n, 9) = arr(i, 9)
arr2(n, 10) = arr(i, 10)
arr2(n, 11) = arr(i, 11)
arr2(n, 12) = arr(i, 12)
arr2(n, 13) = arr(i, 13)
arr2(n, 14) = arr(i, 14)
arr2(n, 15) = arr(i, 15)
arr2(n, 16) = arr(i, 16)
arr2(n, 17) = arr(i, 17)
arr2(n, 18) = arr(i, 18)
arr2(n, 19) = arr(i, 19)
arr2(n, 20) = arr(i, 20)
arr2(n, 21) = arr(i, 21)
arr2(n, 22) = arr(i, 22)
arr2(n, 23) = arr(i, 23)
arr2(n, 24) = arr(i, 24)
arr2(n, 25) = arr(i, 25)
arr2(n, 26) = arr(i, 26)
arr2(n, 27) = arr(i, 27)
arr2(n, 28) = arr(i, 28)
arr2(n, 29) = arr(i, 29)
arr2(n, 30) = arr(i, 30)
End If
w = UserForm1.Label3.Width
UserForm1.Show 0
h = h + w / l
UserForm1.Label2.Width = h
UserForm1.Label1 = "已完成" & Format(i / l, "0.00%")
UserForm1.Caption = "正在运行，已耗时" & Format(Timer - t, "0.00") & "秒，请稍后！！！"
DoEvents
Next
Sheets("查询表").Range("b4:ae3000") = arr2
Erase arr2
asfb = Sheets("查询表").Range("d100000").End(xlUp).Row
'bsfb = ws.Range("iv" & 2).End(xlToLeft).Column
With Range("b3:ae" & asfb) '设置打印边框 7
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
End With
Range("3:100000").RowHeight = 16
Application.ScreenUpdating = ture
Unload UserForm1
MsgBox Timer - t
End Sub
Sub feiyongchaxun1()
t = Timer
Dim arr2(1 To 3000, 1 To 8)
Dim h, w, y, l, aa, asfb, bsfb As Long

Application.ScreenUpdating = False
Sheets("查询表").[b4:ad100000].Clear

With Sheets("查询表")
.Range("b2:b100000").NumberFormatLocal = "yyyy-m-d"
.Range("c2:c100000").NumberFormatLocal = "@"
.Range("e:e").NumberFormatLocal = "@"
.Range("f:f").NumberFormatLocal = "#,##0.00_ ;[红色]-#,##0.00 "
.Range("g:g").NumberFormatLocal = "@"
.Range("h:h").NumberFormatLocal = "@"
.Range("i:i").NumberFormatLocal = "@"
.Range("g:g").NumberFormatLocal = "@"
End With

aa = Sheets("费用明细表").Range("b1048576").End(xlUp).Row
Range("a2") = aa
arr = Sheets("费用明细表").Range("a2:h" & aa)
'arr = Sheets("结算业绩表").Range("a2", Cells(Rows.Count, "ad").End(xlUp))
l = UBound(arr)
For i = 1 To l
If arr(i, 2) = Sheets("查询表").Range("b1").Value And arr(i, 1) = Sheets("查询表").Range("c1").Value Then
n = n + 1
arr2(n, 1) = arr(i, 1)
arr2(n, 2) = arr(i, 2)
arr2(n, 3) = arr(i, 3)
arr2(n, 4) = arr(i, 4)
arr2(n, 5) = arr(i, 5)
arr2(n, 6) = arr(i, 6)
arr2(n, 7) = arr(i, 7)
arr2(n, 8) = arr(i, 8)
'Sheets("查询表").Cells(n + 2, "b").Resize(1, 8) = WorksheetFunction.Index(arr, i, 0)
End If
w = UserForm1.Label3.Width
UserForm1.Show 0
h = h + w / l
UserForm1.Label2.Width = h
UserForm1.Label1 = "已完成" & Format(i / l, "0.00%")
UserForm1.Caption = "正在运行，已耗时" & Format(Timer - t, "0.00") & "秒，请稍后！！！"
DoEvents
Next
Sheets("查询表").Range("b4:i3000") = arr2
Erase arr2
asfb = Sheets("查询表").Range("d100000").End(xlUp).Row
'bsfb = ws.Range("iv" & 2).End(xlToLeft).Column
With Range("b3:i" & asfb) '设置打印边框 7
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
End With
Range("3:100000").RowHeight = 16
Application.ScreenUpdating = ture
Unload UserForm1
MsgBox Timer - t
End Sub

 

posted on 2018-06-05 14:26  真辉辉  阅读(126)  评论(0)    收藏  举报

导航