Code VBA sort ngày tháng bị lỗi : (Nhờ mọi người sửa) (1 người xem)

[bebo021999]

Mình đang lọ mọ viết code để sort ngày tháng từ 2 cột
VD:
Cột C | Cột D
1-Feb-17 | 6-Mar-2017
5-Dec-16 | 7-May-17
<Ô trống> | 11-Feb-16
1-Sep-17 | 2-Oct-17

Yêu cầu:
1) Sort Cột C và D theo cột C. Cột C có thể có ô trống. Ô trống này sẽ được lấy ngày tương ứng bên cột D. VD: C3=D3
2) Sort tại chỗ, không chuyển dữ liệu qua chỗ khác.

Code viết xong bị lỗi: Cột C trả về giá trị text nên sort bị sai.

Mình đi theo hướng copy sang sheet mới, sort xong copy ngược lại. không biết có hợp lý không?

Hình thù em nó thế này:

Sub sort()
Dim Date1(), Date2() As Long
Dim R As Range
Dim WS As Worksheet
Dim i, lR As Long
Application.ScreenUpdating = False
lR = Cells(Rows.Count, "D").End(xlUp).Row

'read date into Arr
ReDim Date1(1 To lR)
ReDim Date2(1 To lR)
    For i = 1 To lR
       Date1(i) = Cells(i, "C").Value
       Date2(i) = Cells(i, "D").Value
       If Cells(i, "C") = "" Then
            Date1(i) = Cells(i, "D").Value
       End If
    Next i

'Copy Arr to tem sheet
    Set WS = ThisWorkbook.Worksheets.Add
    Set R = WS.Range("A1").Resize(lR, 1)
    R = Application.Transpose(Date1)
    R.Offset(0, 1) = Application.Transpose(Date2)

'Sort
    Union(R, R.Offset(0, 1)).sort key1:=R, order1:=xlAscending
    
    For i = 1 To lR
'Copy sort date back to array
        Date1(i) = R(i, 1)
        Date2(i) = R(i, 1).Offset(0, 1)
    Next i
    Application.DisplayAlerts = False
    WS.Delete
    Application.DisplayAlerts = True
'Read array to range
Range("C1", Cells(lR, "C")) = Application.Transpose(Date1)
Range("D1", Cells(lR, "D")) = Application.Transpose(Date2)
Application.ScreenUpdating = True
End Sub

Xin cảm ơn.

 

[Phuocam]

Thử cách này ...

Sub SortDate()
Dim Lr, i
Lr = Cells(Rows.Count, "D").End(xlUp).Row
    For i = 1 To Lr
        If Cells(i, 3) = "" Then Cells(i, 3) = Cells(i, 4)
    Next
Range("C1:D" & Lr).sort [C1]
End Sub

 

[bebo021999]

Thank Phuocam, để mình thử lại.

 

[SA_DQ]

Nếu là mình, mình sẽ làm vầy:

1./ Chọn cột [C] & thêm 1 cột trống

2./ Viết hàm người dùng để biến 1-Feb-17 thành chuổi F21;
Ở đây F chỉ năm 2017; con 2 chỉ tháng; Tháng 10 sẽ là A
Con 1 chỉ ngày; B sẽ là ngày 11
Cú fáp Hàm người dùng có thể là =DateToString(Dat As Date) As String

3./ Áp hàm người dùng lên cột trống [C] & Sắp xếp 3 cột dữ liệu theo nó

4./ Xóa cột vừa tạo

(Các bước này hoàn toàn có thể là VBA)

 

[quanluu]

Mình đang lọ mọ viết code để sort ngày tháng từ 2 cột
VD:
Cột C | Cột D
1-Feb-17 | 6-Mar-2017
5-Dec-16 | 7-May-17
<Ô trống> | 11-Feb-16
1-Sep-17 | 2-Oct-17

Yêu cầu:
1) Sort Cột C và D theo cột C. Cột C có thể có ô trống. Ô trống này sẽ được lấy ngày tương ứng bên cột D. VD: C3=D3
2) Sort tại chỗ, không chuyển dữ liệu qua chỗ khác.

Code viết xong bị lỗi: Cột C trả về giá trị text nên sort bị sai.

Mình đi theo hướng copy sang sheet mới, sort xong copy ngược lại. không biết có hợp lý không?

Hình thù em nó thế này:

Sub sort()
Dim Date1(), Date2() As Long
Dim R As Range
Dim WS As Worksheet
Dim i, lR As Long
Application.ScreenUpdating = False
lR = Cells(Rows.Count, "D").End(xlUp).Row

'read date into Arr
ReDim Date1(1 To lR)
ReDim Date2(1 To lR)
    For i = 1 To lR
       Date1(i) = Cells(i, "C").Value
       Date2(i) = Cells(i, "D").Value
       If Cells(i, "C") = "" Then
            Date1(i) = Cells(i, "D").Value
       End If
    Next i

'Copy Arr to tem sheet
    Set WS = ThisWorkbook.Worksheets.Add
    Set R = WS.Range("A1").Resize(lR, 1)
    R = Application.Transpose(Date1)
    R.Offset(0, 1) = Application.Transpose(Date2)

'Sort
    Union(R, R.Offset(0, 1)).sort key1:=R, order1:=xlAscending
    
    For i = 1 To lR
'Copy sort date back to array
        Date1(i) = R(i, 1)
        Date2(i) = R(i, 1).Offset(0, 1)
    Next i
    Application.DisplayAlerts = False
    WS.Delete
    Application.DisplayAlerts = True
'Read array to range
Range("C1", Cells(lR, "C")) = Application.Transpose(Date1)
Range("D1", Cells(lR, "D")) = Application.Transpose(Date2)
Application.ScreenUpdating = True
End Sub

Xin cảm ơn.

Mình góp them 1 code khác

Sub test()
Dim lR As Integer
    lR = Cells(Rows.Count, "D").End(xlUp).Row
    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"";"
    Range("C1").CopyFromRecordset cn.Execute("SELECT  iif(f1 is null,f2,f1), f2 FROM [C1:D" & lR & "] order by iif(f1 is null,f2,f1)")
End Sub