如何在VB6中按date对Excel数据进行sorting
我想按datesorting，这是我的工作表的中间列。 即时通讯从一个数据库系统获取我的数据，但我不能在该系统中sorting我需要sorting的数据，这是我的：
| A FIELD | B FIELD | C FIELD | DATE FIELD | E FIELD | F FIELD | | Adata1 | Bdata | Cdata | 09.05.2011 | Edata | Fdata | | Adata2 | Bdata | Cdata | 03.05.2011 | Edata | Fdata | | Adata3 | Bdata | Cdata | 21.05.2011 | Edata | Fdata | | Adata4 | Bdata | Cdata | 01.05.2011 | Edata | Fdata | | Adata5 | Bdata | Cdata | 11.05.2011 | Edata | Fdata | 而且我应该find一种方法来使它像这样比粘贴到Excel：
| A FIELD | B FIELD | C FIELD | DATE FIELD | E FIELD | F FIELD | | Adata4 | Bdata | Cdata | 01.05.2011 | Edata | Fdata | | Adata2 | Bdata | Cdata | 03.05.2011 | Edata | Fdata | | Adata1 | Bdata | Cdata | 09.05.2011 | Edata | Fdata | | Adata5 | Bdata | Cdata | 11.05.2011 | Edata | Fdata | | Adata3 | Bdata | Cdata | 21.05.2011 | Edata | Fdata |
所以我怎样才能做到这一点在VB6到Excel？ 我可以使用它的助手，并从它读取数据顺序/sorting比粘贴回到Excel，但哪些助手OLE？
Dim strcnn As String Dim cnn As New ADODB.Connection Dim Cmd As New ADODB.Command Dim rs As New ADODB.Recordset Private Sub Form_Load() 'Create database connection strcnn = "MyConnectionToDb" cnn.Open strcnn Cmd.ActiveConnection = cnn End Sub Private Sub Command1_Click() Dim i As Integer Dim cek As String Dim tarih As String 'Set excel Set kitap = CreateObject("Excel.Application") kitap.Workbooks.Add 'Data Query cek = "SELECT * FROM DATATEST.trolololollololollololoo" rs.Open cek, cnn 'If result is empty If rs.EOF = True Then 'Report situation Situation.Caption = "Situation : is under control!" Else 'Start counter i = i + 1 'Add headers kitap.Cells(i, 1).Value = "SN" kitap.Cells(i, 2).Value = "OP" kitap.Cells(i, 3).Value = "HF" kitap.Cells(i, 4).Value = "UC" kitap.Cells(i, 5).Value = "HA" kitap.Cells(i, 6).Value = "UA" kitap.Cells(i, 7).Value = "IN" 'While not end of file Do While Not rs.EOF 'Increase the Counter i = i + 1 'Add the data kitap.Cells(i, 1).Value = rs.Fields("SN") kitap.Cells(i, 2).Value = rs.Fields("OP") kitap.Cells(i, 3).Value = rs.Fields("HF") kitap.Cells(i, 4).Value = rs.Fields("UC") kitap.Cells(i, 5).Value = rs.Fields("HA") kitap.Cells(i, 6).Value = dotdate(rs.Fields("UA")) 'UA is date field, this will be the key column kitap.Cells(i, 7).Value = rs.Fields("IN") 'to sort all data is being saved to excel. 'Next record rs.MoveNext Loop 'Close data connection rs.Close End If 'Save data to excel kitap.ActiveWorkbook.SaveAs(App.Path & "\troll.xls") kitap.Application.Quit 'Report situation Situation.Caption = "Situation : Excel Formatted Troll is Ready" Exit Sub Error: 'On error close connection rs.Close 'Report situation Situation.Caption = "Critical ERROR! : Connection has been trolled! Reset ur computer." End Sub
做你想做的最简单的方法似乎是从数据库中返回数据。 代替：
"Select * From DATATEST.trolololollololollololoo"
尝试
"Select * From DATATEST.trolololollololollololoo ORDER BY [Date Field Name]"
说实话 – 我不明白你的问题。 事实上，我认为你自己创造了这个问题。 你为什么不直接复制数据，然后运行下面的东西呢？
'set autofilter Me.Range(Cells(1,1), Cells(lastRow, lastColumn)).AutoFilter 'sort Me.AutoFilter.Range.Sort Key1:=Cells(rowDateField, 1), Order1:=xlAscending, Header:=xlYes
sorting完成。
我find了解决scheme。 这是一个糟糕的代码，但解决了这个问题。
OptionExplit Dim strcnn As String Dim cnn As New ADODB.Connection Dim Cmd As New ADODB.Command Dim rs As New ADODB.Recordset Private Sub Form_Load() 'Create database connection strcnn = "MyConnectionToDb" cnn.Open strcnn Cmd.ActiveConnection = cnn End Sub 'Sorting function here! Public Function OrderByDate() Dim i, j, k As Integer Dim temp(100, 50) As Variant 'for my work here 100 was enough.. change it if u got more items in ur excel data. Dim xlApp As Excel.Application Dim xlWorkBook As Excel.Workbook Dim xlWorkSheet As Excel.Worksheet 'Set excel Set xlApp = New Excel.Application Set xlWorkBook = xlApp.Workbooks.Open(App.Path & "\my.xls") Set xlWorkSheet = xlWorkBook.Worksheets(1) 'Start working on worksheet With xlWorkSheet 'Start counters i = 2 j = 3 k = 1 'Report situation Situation.Caption = "Situation : Ordering by Date." 'Till Excell Book finishes Do While Not k = .Rows.Count - 1 'When you reach empty cells in ur sheet it means you're at the end of ur data. 'So finish there. If UnDotAndTurn(Replace(Trim(.Cells(j, 6)), ".", "")) = "" Then 'Exit Exit Do Else 'ReOrder the data If UnDotAndTurn(Replace(Trim(.Cells(i, 6)), ".", "")) > UnDotAndTurn(Replace(Trim(.Cells(j, 6)), ".", "")) Then 'First get the values to a template temp(i, 1) = .Cells(j, 1) temp(i, 2) = .Cells(j, 2) temp(i, 3) = .Cells(j, 3) temp(i, 4) = .Cells(j, 4) temp(i, 5) = .Cells(j, 5) temp(i, 6) = .Cells(j, 6) temp(i, 7) = .Cells(j, 7) 'Then get the next value into current .Cells(j, 1).Value = .Cells(i, 1) .Cells(j, 2).Value = .Cells(i, 2) .Cells(j, 3).Value = .Cells(i, 3) .Cells(j, 4).Value = .Cells(i, 4) .Cells(j, 5).Value = .Cells(i, 5) .Cells(j, 6).Value = .Cells(i, 6) .Cells(j, 7).Value = .Cells(i, 7) 'At last write the values in temp to next value set .Cells(i, 1).Value = temp(i, 1) .Cells(i, 2).Value = temp(i, 2) .Cells(i, 3).Value = temp(i, 3) .Cells(i, 4).Value = temp(i, 4) .Cells(i, 5).Value = temp(i, 5) .Cells(i, 6).Value = temp(i, 6) .Cells(i, 7).Value = temp(i, 7) 'return previous data to see if its still-> '->higher than what data comes before it. If i <= 3 Then i = i - 1 ElseIf i > 3 Then i = i - 2 j = j - 2 End If ElseIf UnDotAndTurn(Replace(Trim(.Cells(i, 6).Value), ".", "")) = UnDotAndTurn(Replace(Trim(.Cells(j, 6).Value), ".", "")) Then 'do smt here if u need to do! when they are equals to each other ElseIf UnDotAndTurn(Replace(Trim(.Cells(i, 6).Value), ".", "")) < UnDotAndTurn(Replace(Trim(.Cells(j, 6).Value), ".", "")) Then 'do smt here if u need to do! when i lower than j End If '+1 to go next data i = i + 1 j = j + 1 k = k + 1 End If Loop 'Report situation Situation.Caption = "Situation : Order Finished! Saving." 'Save worksheet .SaveAs (App.Path & "\my.xls") End With 'Save workbook xlWorkBook.Save xlWorkBook.Close xlApp.Quit 'Report situation Situation.Caption = "Situation : Changes Saved!" End Function 'Take date data as string and clear "." and turn it to yyyymmdd together. Public Function UnDotAndTurn(ByRef elem) As String Dim Day, Month, Year As String 'Clear dots and spaces elem = Trim(elem) elem = Replace(elem, ".", "") 'If result is empty If elem = "" Then 'Return empty elem = 0 UnDotAndTurn = "" ElseIf elem <> "" Then 'Get date values Year = Right(elem, 4) Month = Mid(elem, Len(elem) - 5, 2) Day = Mid(elem, 1, Len(elem) - 6) 'If "Day" is 1 charachter long than add 0 to head to get this: 09 If Len(Day) = 1 Then Day = "0" & Day End If 'Return result UnDotAndTurn = Year & Month & Day End If End Function 'i use this while i read data from my db it takes date field as numeric like 9082011 'and i turn it into 09.08.2011 date format, putting dots to make it more understandable Public Function dotdate(ByRef elem) As String Dim Day, Month, Year As String 'Get date values Year = Right(elem, 4) Month = Mid(elem, Len(elem) - 5, 2) Day = Mid(elem, 1, Len(elem) - 6) 'If "Day" is 1 charachter long than add 0 to head to get this: 09 If Len(Day) = 1 Then Day = "0" & Day End If 'Return result dotdate = Day & "." & Month & "." & Year End Function Private Sub Command1_Click() Dim i, j As Integer Dim cek As String Dim xlApp As Excel.Application Dim xlWorkBook As Excel.Workbook Dim xlWorkSheet As Excel.Worksheet 'Set excel Set xlApp = New Excel.Application Set xlWorkBook = xlApp.Workbooks.Add Set xlWorkSheet = xlWorkBook.Worksheets(1) 'With worksheet With xlWorkSheet 'Data Query cek = "Select * From DATATEST.trolololollololollololoo" rs.Open cek, cnn 'Start counter j = 1 'If result is empty If rs.EOF = True Then 'Report situation Situation.Caption = "Situation : End Of File! END OF LIFE! RUN AWAY!" Else 'Add headers .Cells(j, 1).Value = "SN" .Cells(j, 2).Value = "OP" .Cells(j, 3).Value = "HF" .Cells(j, 4).Value = "UC" .Cells(j, 5).Value = "HA" .Cells(j, 6).Value = "UA" .Cells(j, 7).Value = "IN" 'Increase the Counter j = j + 1 'While not end of file Do While Not rs.EOF 'Add the data .Cells(j, 1).Value = rs.Fields("SN") .Cells(j, 2).Value = rs.Fields("OP") .Cells(j, 3).Value = rs.Fields("HF") .Cells(j, 4).Value = rs.Fields("UC") .Cells(j, 5).Value = rs.Fields("HA") .Cells(j, 6).Value = dotdate(rs.Fields("UA")) .Cells(j, 7).Value = rs.Fields("IN") 'Increase the Counter j = j + 1 'Next record rs.MoveNext Loop 'Close data connection rs.Close End If 'Save worksheet .SaveAs (App.Path & "\my.xls") End With 'Save workbook xlWorkBook.Save xlWorkBook.Close xlApp.Quit 'Order excel file DoEvents OrderByDate 'Report situation Situation.Caption = "Situation : Excel Formatted Troll is Ready" Exit Sub Error: 'On error close connection rs.Close 'Report situation Situation.Caption = "Critical ERROR! : Connection has been trolled! Reset ur computer." End Sub