Question

我想按日期排序，这是我工作表的中间栏。我从数据库系统获取数据，但我无法在该系统中对其进行排序，我需要对我这样的数据进行排序：

| 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

执行所需操作的最简单方法似乎是对从数据库返回的数据进行排序。而不是：

"Select * From DATATEST.trolololollololollololoo"

尝试

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

Answer 2

说实话 - 我不明白你的问题。事实上，我认为你自己创造了这个问题。你为什么不按原样复制数据，然后运行如下所示的内容？

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

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

完成排序。

Answer 3

我找到了解决方案。这是一个形状错误的代码，但解决了这个问题。

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

如何在VB6中按日期对Excel数据进行排序

3 个答案: