Nhờ chỉnh sửa công thức: tìm và sắp xếp dữ liệu theo thời gian (1 người xem)

YenLV · 15/9/18

Em lập công thức tìm và sắp xếp dữ liệu theo thời gian nhưng chưa đạt được như ý muốn như file đính kèm. Mong các anh/chị giúp đỡ

Phan Thế Hiệp · 15/9/18

laivanyen8 đã viết:
Em lập công thức tìm và sắp xếp dữ liệu theo thời gian nhưng chưa đạt được như ý muốn như file đính kèm. Mong các anh/chị giúp đỡ

Thử: (sử dụng excel từ 2010 trở lên)

Mã:

A10=AGGREGATE(15,6,$A$2:$G$6,ROW($A1))
B10=INDIRECT(MID(REPT(TEXT(AGGREGATE(15,6,(COLUMN($B$1:$H$1)*10^3+ROW($A$1:$A$6))/($A$1:$G$6=$A10),COUNTIF($A$10:$A10,$A10)),"C000R000"),2),5,8),)

Enter, fill xuống
Xem file kèm.

Thân

YenLV · 15/9/18

Cảm ơn anh nhưng vấn đề hàm của anh là tham chiếu dữ liệu sheet khác là mất kết quả, có cách nào khắc phục không ạ ! (và vấn đề nữa hàm này đang ưu tiên thứ tự trên xuống dưới, sau đó từ trái sang phải. Em muốn ưu tiên nhưng ngày trùng nhau thì dữ liệu ưu tiên là từ trái sang phải trước sau là trên xuống dưới ạ)
Thử: (sử dụng excel từ 2010 trở lên)

Phan Thế Hiệp · 15/9/18

laivanyen8 đã viết:
Cảm ơn anh nhưng vấn đề hàm của anh là tham chiếu dữ liệu sheet khác là mất kết quả, có cách nào khắc phục không ạ ! (và vấn đề nữa hàm này đang ưu tiên thứ tự trên xuống dưới, sau đó từ trái sang phải. Em muốn ưu tiên nhưng ngày trùng nhau thì dữ liệu ưu tiên là từ trái sang phải trước sau là trên xuống dưới ạ)
Thử: (sử dụng excel từ 2010 trở lên)

Xem file kèm.

Thân

YenLV · 10/10/18

Phan Thế Hiệp đã viết:
Xem file kèm.

Thân

anh ơi. hàm của anh chạy đạt mong muốn về yêu cầu kỹ thuật nhưng khi em chạy với dữ liệu lên đến 1000 hàng tốc độ xử lý rất chậm (như file em đính kèm), Mong anh giúp đỡ em giải quyết vấn đề này, em chân thành cảm ơn !

HieuCD · 10/10/18

laivanyen8 đã viết:
anh ơi. hàm của anh chạy đạt mong muốn về yêu cầu kỹ thuật nhưng khi em chạy với dữ liệu lên đến 1000 hàng tốc độ xử lý rất chậm (như file em đính kèm), Mong anh giúp đỡ em giải quyết vấn đề này, em chân thành cảm ơn !

Du2ng code Vba

Mã:

Sub XepThuTu()
  Dim sh As Worksheet
  Dim j As Long, sRow As Long, sCol As Long, eRow As Long
  Set sh = Sheets("Sheet2") 'Dat sh là Sheet2 
  eRow = sh.Range("A" & Rows.Count).End(xlUp).Row  'Dong cuoi Sheet2
  If eRow > 1 Then sh.Range("A2:B" & eRow).ClearContents 'Xoa du lieu cu
  With Sheets("Sheet1")
    sRow = .Range("A1").CurrentRegion.Rows.Count - 1 'So dong du lieu Sheet1(tu dong 2 xuong)
    sCol = .Range("AAA1").End(xlToLeft).Column 'So cot du lieu
    If sCol < 2 Then Exit Sub 'Khong co du lieu 2 cot, thoat Sub
    For j = 1 To sCol Step 2
      eRow = sh.Range("A" & Rows.Count).End(xlUp).Row 'Dong cuoi Sheet 2
      sh.Range("A" & eRow + 1).Resize(sRow, 2) = .Cells(2, j).Resize(sRow, 2).Value 'Gán du lieu sheet1 qua sheet2
    Next j
    eRow = sh.Range("A" & Rows.Count).End(xlUp).Row
    sh.Range("A1:B" & eRow).Sort sh.[A1], 1, sh.[B1], , 1, Header:=xlYes 'Sort du lieu
  End With
End Sub

huonglien1901 · 11/10/18

HieuCD đã viết:

Du2ng code Vba

Mã:

Sub XepThuTu()
  Dim sh As Worksheet
  Dim j As Long, sRow As Long, sCol As Long, eRow As Long
  Set sh = Sheets("Sheet2")
  eRow = sh.Range("A" & Rows.Count).End(xlUp).Row
  If eRow > 1 Then sh.Range("A2:B" & eRow).ClearContents
  With Sheets("Sheet1")
    sRow = .Range("A1").CurrentRegion.Rows.Count - 1
    sCol = .Range("AAA1").End(xlToLeft).Column
    If sCol < 2 Then Exit Sub
    For j = 1 To sCol Step 2
      eRow = sh.Range("A" & Rows.Count).End(xlUp).Row
      sh.Range("A" & eRow + 1).Resize(sRow, 2) = .Cells(2, j).Resize(sRow, 2).Value
    Next j
    eRow = sh.Range("A" & Rows.Count).End(xlUp).Row
    sh.Range("A1:B" & eRow).Sort sh.[A1], 1, sh.[B1], , 1, Header:=xlYes
  End With
End Sub

Anh ơi! Anh có thể chú thích trong code được không Anh?
cảm ơn Anh nhiều!

HieuCD · 11/10/18

huonglien1901 đã viết:
Anh ơi! Anh có thể chú thích trong code được không Anh?
cảm ơn Anh nhiều!

Mới thêm chú thích bài #6

YenLV · 18/10/18

HieuCD đã viết:
Mới thêm chú thích bài #6

Anh ơi. VBA của anh ứng dụng được cột A (date) còn ở cột B hiện tại đang ưu tiên sắp xếp theo thứ tự chữ cái, em mong muốn là sắp xếp thứ tự ở cột B (List) TH1: ưu tiên trên xuống dưới và TH2: ưu tiên từ trái qua phải như các bảng Excel em nhờ anh Phan Thế Hiệp ạ, anh có thể chỉnh sửa lại code VBA giúp em không ạ

HieuCD · 18/10/18

laivanyen8 đã viết:
Anh ơi. VBA của anh ứng dụng được cột A (date) còn ở cột B hiện tại đang ưu tiên sắp xếp theo thứ tự chữ cái, em mong muốn là sắp xếp thứ tự ở cột B (List) TH1: ưu tiên trên xuống dưới và TH2: ưu tiên từ trái qua phải như các bảng Excel em nhờ anh Phan Thế Hiệp ạ, anh có thể chỉnh sửa lại code VBA giúp em không ạ

Hai cách xếp

Mã:

Sub XepTraiPhai()
  Dim sh As Worksheet, sArr(), Res()
  Dim j As Long, sRow As Long, sCol As Long, eRow As Long
  Set sh = Sheets("Sheet2")
  With Sheets("Sheet2")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 1 Then .Range("A2:B" & i + 1).ClearContents
  End With

  sArr = Sheets("Sheet1").Range("A1").CurrentRegion.Value
  sRow = UBound(sArr, 1):    sCol = Int(UBound(sArr, 2) / 2) * 2
  If sCol < 2 Then Exit Sub
  ReDim Res(1 To (sRow - 1) * sCol, 1 To 2)
 
  For j = 1 To sCol Step 2
    For i = 2 To sRow
      If Len(sArr(i, j)) + Len(sArr(i, j + 1)) > 0 Then
        k = k + 1
        Res(k, 1) = sArr(i, j): Res(k, 2) = sArr(i, j + 1)
      End If
    Next i
  Next j
  Sheets("Sheet2").Range("A2:B2").Resize(k) = Res
End Sub

Sub XepTrenXuong()
  Dim sh As Worksheet, sArr(), Res()
  Dim j As Long, sRow As Long, sCol As Long, eRow As Long
  Set sh = Sheets("Sheet2")
  With Sheets("Sheet2")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 1 Then .Range("A2:B" & i + 1).ClearContents
  End With

  sArr = Sheets("Sheet1").Range("A1").CurrentRegion.Value
  sRow = UBound(sArr, 1):    sCol = Int(UBound(sArr, 2) / 2) * 2
  If sCol < 2 Then Exit Sub
  ReDim Res(1 To (sRow - 1) * sCol, 1 To 2)
 
  For i = 2 To sRow
    For j = 1 To sCol Step 2
      If Len(sArr(i, j)) + Len(sArr(i, j + 1)) > 0 Then
        k = k + 1
        Res(k, 1) = sArr(i, j): Res(k, 2) = sArr(i, j + 1)
      End If
    Next j
  Next i
  Sheets("Sheet2").Range("A2:B2").Resize(k) = Res
End Sub

YenLV · 19/10/18

Hai cách xếp
Xin lỗi anh vì em đã yêu cầu nhiều mà không giải thích rõ anh hiểu hết để anh hiểu nhưng ý của em là
1. Cột A sắp xếp theo thứ thự thời gian từ 1- hết, nếu 2 ngày có giá trị trùng nhau thì lấy theo thứ tự ưu tiên TH1: trái sang phải, TH2: trên xuống dưới.
2. Cột B lấy dữ liệu tương ứng của cột A
Về code VBA của anh giúp em:
1.#6 đáp ứng được yêu cầu về sắp xếp thời gian nhưng không thỏa mãn điều kiện lấy dữ liệu ở cột B
2.#10 đáp ứng yêu cầu sắp xếp trái phải, trên dưới nhưng không có sắp xếp được theo thời gian ở cột A
Anh có thể xem cụ thể file ở #4 giúp em ạ ! em chân thành cảm ơn.

Phuocam · 19/10/18

Thử:

1. Lấy dữ liệu từ trái qua phải. từ trên xuống

2. Sort cột A.

YenLV · 19/10/18

phuocam đã viết:
Thử:

1. Lấy dữ liệu từ trái qua phải. từ trên xuống
2. Sort cột A.

Đúng là làm vậy là đạt yêu cầu nhưng em nhờ anh ghép luôn vào code VBA vì bảng tính em gồm nhiều cột và dữ liệu khác nữa, nếu dùng cách như anh hướng dẫn thì mỗi lần làm phải copy sang một sheet mới và copy ngược lại ạ

YenLV · 20/10/18

HieuCD đã viết:
Hai cách xếp
Anh ơi anh giúp em sửa lại bổ sung giúp em một chút được không ạ, phần giữ liệu đầu vào ở sheet1 giờ em chỉ muốn lấy vùng từ cột C đến cột H mà không lấy cột A và B nữa ạ hoặc chỉ một vùng nhất định mà người sử dụng có thể thay đổi tùy công việc ạ. Em chân thành cảm ơn

HieuCD · 21/10/18

Bài 4 sort theo cột A mờ, Không hiểu bạn muốn sort theo kiểu nào, sort tay gởi kết quả lên

YenLV · 21/10/18

HieuCD đã viết:
Bài 4 sort theo cột A mờ, Không hiểu bạn muốn sort theo kiểu nào, sort tay gởi kết quả lên

Vâng phần sort thì em copy phần
eRow = sh.Range("A" & Rows.Count).End(xlUp).Row
sh.Range("A1:B" & eRow).Sort sh.[A1], 1, sh.[B1], , 1, Header:=xlYes
của anh vào đoạn code mới, em test thì được rồi ạ.
Anh giúp em sửa lại code, phần giữ liệu đầu vào ở sheet1 giờ em chỉ muốn lấy vùng từ cột C đến cột H mà không lấy cột A và B nữa ạ (một vùng nhất định có thể thay đổi trong đoạn code để người sử dụng có thể thay đổi tùy công việc ạ). Em chân thành cảm ơn !

Ba Tê · 21/10/18

laivanyen8 đã viết:
Anh giúp em sửa lại code, phần giữ liệu đầu vào ở sheet1 giờ em chỉ muốn lấy vùng từ cột C đến cột H mà không lấy cột A và B nữa ạ (một vùng nhất định có thể thay đổi trong đoạn code để người sử dụng có thể thay đổi tùy công việc ạ).

HieuCD · 21/10/18

laivanyen8 đã viết:
Vâng phần sort thì em copy phần
eRow = sh.Range("A" & Rows.Count).End(xlUp).Row
sh.Range("A1:B" & eRow).Sort sh.[A1], 1, sh.[B1], , 1, Header:=xlYes
của anh vào đoạn code mới, em test thì được rồi ạ.
Anh giúp em sửa lại code, phần giữ liệu đầu vào ở sheet1 giờ em chỉ muốn lấy vùng từ cột C đến cột H mà không lấy cột A và B nữa ạ (một vùng nhất định có thể thay đổi trong đoạn code để người sử dụng có thể thay đổi tùy công việc ạ). Em chân thành cảm ơn !

Mã:

Sub XepThuTu()
  Dim Rng As Range
  Dim j As Long, sRow As Long, sCol As Long, eRow As Long
  With Sheets("Sheet2")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow > 1 Then .Range("A2:B" & eRow).ClearContents
    On Error Resume Next
    Set Rng = Application.InputBox("Chon vung du lieu", "Input Range", Type:=8)
    If Err.Number > 0 Then MsgBox ("Chua chon vùng du lieu"): On Error GoTo 0:      Exit Sub
    sCol = Rng.Columns.Count
    If sCol < 2 Then MsgBox ("Chon vùng du lieu có hon 2 cot"):     Exit Sub
    sRow = Rng.Rows.Count
    For j = 1 To sCol Step 2
      eRow = .Range("A" & Rows.Count).End(xlUp).Row
      .Range("A" & eRow + 1).Resize(sRow, 2) = Rng.Cells(1, j).Resize(sRow, 2).Value
    Next j
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A1:B" & eRow).Sort .[A1], 1, .[B1], , 1, Header:=xlYes
  End With
End Sub

YenLV · 21/10/18

@Ba Tê
Vâng cảm ơn Thầy. Thầy có thể giúp em thêm 1 trường hợp nữa là các ngày trùng nhau ưu tiên lấy dữ liệu trên xuống dưới, sau đó mới từ trái sang phải được không ạ, hiện code Thầy vừa viết đang ưu tiên cho các ngày trùng nhau lấy từ trái sang phải, sau trên xuống dưới ! Em cần cả 2 ạ
Và vùng dữ liệu từ cột thầy đưa luôn vào code giúp em với ạ, ví dụ từ cột C:H em sẽ chủ động thay đổi vùng đó ạ

YenLV · 21/10/18

@HieuCD
Em cảm ơn anh nhưng em test thử thì Code lấy dữ liệu cho code B những ngày trùng nhau thì không được theo quy luật ưu tiên nào ạ, anh xem lại giúp em; em muốn lấy theo thứ tự không theo Alpha B của chữ cái mà ưu tiên th1: từ trên xuống dưới và th2: trái qua phải. Và vùng dữ liệu em cũng muốn đưa luôn vào code, em sẽ chủ động thay đổi vùng đó trong code ạ

Ba Tê · 21/10/18

laivanyen8 đã viết:
@Ba Tê
Vâng cảm ơn Thầy. Thầy có thể giúp em thêm 1 trường hợp nữa là các ngày trùng nhau ưu tiên lấy dữ liệu trên xuống dưới, sau đó mới từ trái sang phải được không ạ, hiện code Thầy vừa viết đang ưu tiên cho các ngày trùng nhau lấy từ trái sang phải, sau trên xuống dưới ! Em cần cả 2 ạ
Và vùng dữ liệu từ cột thầy đưa luôn vào code giúp em với ạ, ví dụ từ cột C:H em sẽ chủ động thay đổi vùng đó ạ

Chủ động thay đổi vùng sao bằng chọn vùng trực tiếp?
Muốn cả hai trường hợp sao biết lúc nào muốn gì, cho 2 nút của 2 trường hợp luôn.

HieuCD · 21/10/18

laivanyen8 đã viết:
@HieuCD
Em cảm ơn anh nhưng em test thử thì Code lấy dữ liệu cho code B những ngày trùng nhau thì không được theo quy luật ưu tiên nào ạ, anh xem lại giúp em; em muốn lấy theo thứ tự không theo Alpha B của chữ cái mà ưu tiên th1: từ trên xuống dưới và th2: trái qua phải. Và vùng dữ liệu em cũng muốn đưa luôn vào code, em sẽ chủ động thay đổi vùng đó trong code ạ

Thu code

Mã:

Sub XepThuTu()
  Dim Rng As Range
  Dim j As Long, sRow As Long, sCol As Long, fRow As Long, eRow As Long
  Set Rng = Sheets("Sheet1").Range("A2:H10")
  sCol = Int(Rng.Columns.Count / 2) * 2
  If sCol < 2 Then MsgBox ("Vùng du lieu phai >= 2 cot"):     Exit Sub
  sRow = Rng.Rows.Count
  With Sheets("Sheet2")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow > 1 Then .Range("A2:B" & eRow).ClearContents
    For j = 1 To sCol Step 2
      eRow = .Range("A" & Rows.Count).End(xlUp).Row
      .Range("A" & eRow + 1).Resize(sRow, 2) = Rng.Cells(1, j).Resize(sRow, 2).Value
    Next j
    eRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
    .Range("A2:B" & eRow).Sort .Range("A2"), 1, Header:=xlNo
  End With
End Sub

huonglien1901 · 21/10/18

HieuCD đã viết:

Thu code

Mã:

Sub XepThuTu()
  Dim Rng As Range
  Dim j As Long, sRow As Long, sCol As Long, fRow As Long, eRow As Long
  Set Rng = Sheets("Sheet1").Range("A2:H10")
  sCol = Int(Rng.Columns.Count / 2) * 2
  If sCol < 2 Then MsgBox ("Vùng du lieu phai >= 2 cot"):     Exit Sub
  sRow = Rng.Rows.Count
  With Sheets("Sheet2")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow > 1 Then .Range("A2:B" & eRow).ClearContents
    For j = 1 To sCol Step 2
      eRow = .Range("A" & Rows.Count).End(xlUp).Row
      .Range("A" & eRow + 1).Resize(sRow, 2) = Rng.Cells(1, j).Resize(sRow, 2).Value
    Next j
    eRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
    .Range("A2:B" & eRow).Sort .Range("A2"), 1, Header:=xlNo
  End With
End Sub

Anh Hiếu có thể giải thích giải thuật dòng code này được không?

YenLV · 21/10/18

@Ba Tê
Vâng em cảm ơn Thầy làm cả 2 trường hợp về thứ tự ưu tiên lựa chọn khi trùng nhau như vậy đạt ý nguyện của em rồi, giờ em muốn thêm một chút "Chủ động thay đổi vùng sao bằng chọn vùng trực tiếp?" nghĩa là bổ sung đoạn code chọn vùng như trong đoạn code của anh HieuCd
Set Rng = Sheets("Sheet1").Range("A2:H100"). Vùng A2H100 là vùng em có thể thay đổi đối với mỗi dự án sẽ cố định phần này, không phải quét lại vùng mỗi khi chạy lại VBA khi có thay đổi dữ liệu đầu vào ạ.

Bài đã được tự động gộp: 21/10/18

@HieuCD
yeah.Cảm ơn anh ! anh giúp em thêm trường hợp ưu tiên trái sang phải trước, rồi mới đến trên xuống dưới. Code anh vừa viết với trường hợp ưu tiên trên xuống dưới, trái qua phải như vậy em thấy ok rồi ạ

Ba Tê · 21/10/18

laivanyen8 đã viết:
Vâng em cảm ơn Thầy làm cả 2 trường hợp về thứ tự ưu tiên lựa chọn khi trùng nhau như vậy đạt ý nguyện của em rồi, giờ em muốn thêm một chút "Chủ động thay đổi vùng sao bằng chọn vùng trực tiếp?" nghĩa là bổ sung đoạn code chọn vùng như trong đoạn code của anh HieuCd
Set Rng = Sheets("Sheet1").Range("A2:H100"). Vùng A2H100 là vùng em có thể thay đổi đối với mỗi dự án sẽ cố định phần này, không phải quét lại vùng mỗi khi chạy lại VBA khi có thay đổi dữ liệu đầu vào ạ.

File bài #21.
Thay 2 cái Sub cũ thành 2 cái này rồi tùy chỉnh vùng chọn theo ý muốn.

PHP:

Public Sub sGpe1()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long, Col As Long
sArr = Sheet1.Range("C2:H10000").Value '-------Thay doi vung chon tuy y'
R = UBound(sArr)
Col = UBound(sArr, 2)
ReDim dArr(1 To R * Col, 1 To 2)
For I = 1 To R
    For J = 1 To Col Step 2
        If sArr(I, J) <> Empty Then
            K = K + 1
            dArr(K, 1) = sArr(I, J)
            If J + 1 <= Col Then dArr(K, 2) = sArr(I, J + 1)
        End If
    Next J
Next I
With Sheets("GPE")
    .Select
    .Range("B2").Resize(100000, 2).ClearContents
    .Range("B2").Resize(K, 2) = dArr
    .Range("B2").Resize(K, 2).Sort Key1:=Range("B2"), Order1:=xlAscending
End With
End Sub
Public Sub sGpe2()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long, Col As Long
sArr = Sheet1.Range("C2:H10000").Value '-------Thay doi vung chon tuy y'
R = UBound(sArr)
Col = UBound(sArr, 2)
ReDim dArr(1 To R * Col, 1 To 2)
For J = 1 To Col Step 2
    For I = 1 To R
        If sArr(I, J) <> Empty Then
            K = K + 1
            dArr(K, 1) = sArr(I, J)
            If J + 1 <= Col Then dArr(K, 2) = sArr(I, J + 1)
        End If
    Next I
Next J
With Sheets("GPE")
    .Select
    .Range("B2").Resize(100000, 2).ClearContents
    .Range("B2").Resize(K, 2) = dArr
    .Range("B2").Resize(K, 2).Sort Key1:=Range("B2"), Order1:=xlAscending
End With
End Sub

HieuCD · 24/10/18

laivanyen8 đã viết:
@Ba Tê
Vâng em cảm ơn Thầy làm cả 2 trường hợp về thứ tự ưu tiên lựa chọn khi trùng nhau như vậy đạt ý nguyện của em rồi, giờ em muốn thêm một chút "Chủ động thay đổi vùng sao bằng chọn vùng trực tiếp?" nghĩa là bổ sung đoạn code chọn vùng như trong đoạn code của anh HieuCd
Set Rng = Sheets("Sheet1").Range("A2:H100"). Vùng A2H100 là vùng em có thể thay đổi đối với mỗi dự án sẽ cố định phần này, không phải quét lại vùng mỗi khi chạy lại VBA khi có thay đổi dữ liệu đầu vào ạ.

Bài đã được tự động gộp: 21/10/18

@HieuCD
yeah.Cảm ơn anh ! anh giúp em thêm trường hợp ưu tiên trái sang phải trước, rồi mới đến trên xuống dưới. Code anh vừa viết với trường hợp ưu tiên trên xuống dưới, trái qua phải như vậy em thấy ok rồi ạ

Chạy code, chọn cách sort

Mã:

Sub XepThuTu()
  Dim sArr(), tArr(), Res(), S
  Dim i As Long, k As Long, sRow As Long, j As Byte, sCol As Byte
  Dim t, tMin As Long, tMax As Long
  Dim Msb, Style, Title
  Const VungChon As String = "A2:H10"
 
  With Sheets("Sheet1")
    sArr = .Range(VungChon).Value
    tMin = Application.Min(.Range(VungChon))
    tMax = Application.Max(.Range(VungChon))
  End With
  sCol = Int(UBound(sArr, 2) / 2) * 2
  If sCol < 2 Then MsgBox ("Vùng du lieu phai >= 2 cot"):     Exit Sub
  sRow = UBound(sArr)
  ReDim tArr(tMin To tMax)
  ReDim Res(1 To sRow * sCol / 2, 1 To 2)
 
  Msg = "Yes:   Sort List from Up to Down" & Chr(10) & Chr(10) & "No:   Sort List from Left to Right"
  Style = vbYesNo + vbDefaultButton1
  Title = "Do you want Sort Lists Up to Down ?"
  Response = MsgBox(Msg, Style, Title)
  If Response = vbYes Then    ' User chose Yes.
    For j = 1 To sCol Step 2
      For i = 1 To sRow
        t = CLng(sArr(i, j))
        If t > 0 Then tArr(t) = tArr(t) & "," & sArr(i, j + 1)
      Next i
    Next j
  Else    ' User chose No.
    For i = 1 To sRow
      For j = 1 To sCol Step 2
        t = CLng(sArr(i, j))
        If t > 0 Then tArr(t) = tArr(t) & "," & sArr(i, j + 1)
      Next j
    Next i
  End If
 
  For i = tMin To tMax
    If Len(tArr(i)) > 0 Then
      t = CDate(i)
      S = Split(tArr(i), ",")
      For j = 1 To UBound(S)
        k = k + 1
        Res(k, 1) = t: Res(k, 2) = S(j)
      Next j
    End If
  Next i

  With Sheets("Sheet2")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow > 1 Then .Range("A2:B" & eRow).ClearContents
    If k > 0 Then .Range("A2:B2").Resize(k) = Res
  End With
 
End Sub

YenLV · 24/10/18

@HieuCD
Cảm ơn anh nhiều, chúc anh mạnh khỏe và hạnh phúc ạ

Nhờ chỉnh sửa công thức: tìm và sắp xếp dữ liệu theo thời gian (1 người xem)

Người dùng đang xem chủ đề này

Thành viên chính thức

File đính kèm

-⍟-

File đính kèm

Thành viên chính thức

-⍟-

File đính kèm

Thành viên chính thức

File đính kèm

Chuyên gia GPE

File đính kèm

GPE là ngôi nhà thứ 2 của tôi!!!

Chuyên gia GPE

Thành viên chính thức

Chuyên gia GPE

Thành viên chính thức

Thành viên mới

Thành viên chính thức

Thành viên chính thức

Chuyên gia GPE

Thành viên chính thức

Cạo Rồi Khỏi Gội

File đính kèm

Chuyên gia GPE

Thành viên chính thức

Thành viên chính thức

File đính kèm

Cạo Rồi Khỏi Gội

File đính kèm

Chuyên gia GPE

GPE là ngôi nhà thứ 2 của tôi!!!

Thành viên chính thức

Cạo Rồi Khỏi Gội

Chuyên gia GPE

File đính kèm

Thành viên chính thức

Thời gian đếm ngược.