- ©«¤l
- 976
- ¥DÃD
- 7
- ºëµØ
- 0
- ¿n¤À
- 1018
- ÂI¦W
- 0
- §@·~¨t²Î
- Win10
- ³nÅ骩¥»
- Office 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2013-4-19
- ³Ì«áµn¿ý
- 2024-10-7
|
¥»©«³Ì«á¥Ñ samwang ©ó 2021-12-8 11:33 ½s¿è
¦^´_ 1# wsx1130
½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
1. ¤u³æ¸¹½X/»s¦¨Â²ºÙ: ±q¸ê®Æ®w¨ú°ß¤@ȵM«á¦Û°Ê¶×¥X
2. 2021/11/02 16:06_1080_2021/11/02 16:13
¤u³æ+»sµ{: ²Ä¤@µ§¶}©l®É¶¡ _ ²Ö¥[¼Æ¶q _ ³Ì«á§¹¦¨(max)®É¶¡
Sub test()
Dim conn As New ADODB.Connection
Dim Arr, xD, Brr(), xD1, C%, n%, m%, i&, SD, ED, cnt
Set xD = CreateObject("Scripting.Dictionary")
Set xD1 = CreateObject("Scripting.Dictionary")
With Sheets(3)
.[a1].CurrentRegion.Offset(1) = ""
' .[a1:i1] = Array("ID", "³ø¤u§Ç¸¹", "¤u¸¹", "¯Z§O¥N½X", "³ø¤u¤é´Á", "¤u³æ¸¹½X", "§@·~§Ç¸¹", "»sµ{²ºÙ", "§@·~²Ó¶µ")
' .[j1:q1] = Array("¶}©l®É¶¡", "§¹¦¨®É¶¡", "®É¼Æ", "¼Æ¶q", "¤£¨}¼Æ¶q", "¤u³æ¸¹½X", "³Æµù", "ì¦]¥N½X", "ª¬ºA")
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=D:\database-test.mdb"
.Range("a2").CopyFromRecordset conn.Execute("select * from [DailyReport43600]")
conn.Close
Arr = .[a1].CurrentRegion
End With
ReDim Brr(1 To UBound(Arr), 1 To UBound(Arr))
For i = 2 To UBound(Arr): xD(Arr(i, 8) & "") = "": Next
With Sheets(4)
.[a1].CurrentRegion = ""
.Range("b1").Resize(1, xD.Count) = xD.keys
.[a1] = "¤u³æ¸¹½X/»sµ{²ºÙ"
For i = 2 To UBound(Arr)
C = Application.WorksheetFunction.Match(Arr(i, 8), .Range(.[b1], .Cells(1, xD.Count + 1)), 0) + 1
If xD1.Exists(Arr(i, 6) & "") Then
m = xD1(Arr(i, 6) & "")
If Brr(m, C) <> "" Then
SD = Split(Brr(m, C), "_")(0)
cnt = Split(Brr(m, C), "_")(1)
ED = Split(Brr(m, C), "_")(2)
If Arr(i, 11) > ED Then ED = Arr(i, 11)
End If
Brr(m, C) = SD & "_" & cnt + Arr(i, 13) & "_" & ED
Else
n = n + 1: xD1(Arr(i, 6) & "") = n
Brr(n, 1) = Arr(i, 6)
Brr(n, C) = Arr(i, 10) & "_" & Arr(i, 13) & "_" & Arr(i, 11)
End If
Next
.Range("a2").Resize(n, xD.Count + 1) = Brr
End With
End Sub |
|