Thử: (sử dụng excel từ 2010 trở lên)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 đỡ
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),)
Xem file kèm.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)
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 !Xem file kèm.
Thân
Du2ng code Vbaanh ơ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 !
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
Anh ơi! Anh có thể chú thích trong code được không Anh?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
Mới thêm chú thích bài #6Anh ơi! Anh có thể chú thích trong code được không Anh?
cảm ơn Anh nhiều!
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 ạMới thêm chú thích bài #6
Hai cách xếpAnh ơ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 ạ
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
Đú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 ạThử:
1. Lấy dữ liệu từ trái qua phải. từ trên xuống
2. Sort cột A.
Hai cách xếp
Anh ơi anh giúp em sửa lại bổ sung giúp em một chút được không ạ, phần giữ liệu đầu vào ở sheet1 giờ em chỉ muốn lấy vùng từ cột C đến cột H mà không lấy cột A và B nữa ạ hoặc chỉ một vùng nhất định mà người sử dụng có thể thay đổi tùy công việc ạ. Em chân thành cảm ơn
Vâng phần sort thì em copy phầnBà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
Anh giúp em sửa lại code, phần giữ liệu đầu vào ở sheet1 giờ em chỉ muốn lấy vùng từ cột C đến cột H mà không lấy cột A và B nữa ạ (một vùng nhất định có thể thay đổi trong đoạn code để người sử dụng có thể thay đổi tùy công việc ạ).
Vâng phần sort thì 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
của anh vào đoạn code mới, em test thì được rồi ạ.
Anh giúp em sửa lại code, phần giữ liệu đầu vào ở sheet1 giờ em chỉ muốn lấy vùng từ cột C đến cột H mà không lấy cột A và B nữa ạ (một vùng nhất định có thể thay đổi trong đoạn code để người sử dụng có thể thay đổi tùy công việc ạ). Em chân thành cảm ơn !
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