如何在VB6中按日期對Excel數據進行排序

Question

我想按日期排序，這是我工作表的中間列。 IM從數據庫系統中得到我的數據，但我不能在該系統中它排序，我需要整理其到我這裏來，因爲這數據：

| 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 | 

，我應該找到一種方法，讓這樣比貼以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？我可以使用它的助手，並從它讀取數據順序/排序比粘貼回到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 

Answer 1

我找到了解決辦法。這是一個糟糕的代碼，但解決了這個問題。

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 

Answer 2

最簡單的方法來做你想做的事似乎是從你的數據庫返回的數據。相反的：

"Select * From DATATEST.trolololollololollololoo" 

嘗試

"Select * From DATATEST.trolololollololollololoo ORDER BY [Date Field Name]" 

Answer 3

說實話 - 我不明白你的問題。事實上，我認爲你自己創造了這個問題。爲什麼不按照原樣複製數據，然後運行如下所示的內容？

'set autofilter 
Me.Range(Cells(1,1), Cells(lastRow, lastColumn)).AutoFilter 

'sort 
Me.AutoFilter.Range.Sort Key1:=Cells(rowDateField, 1), Order1:=xlAscending, Header:=xlYes 

排序完成。