Sắp xếp dữ liệu tự động theo điều kiện

phamdoanthang

Thành viên mới
Tham gia ngày
20 Tháng mười hai 2013
Bài viết
21
Được thích
6
Điểm
365
Kính gửi các anh chị trong diễn đàn
Em có 1 bảng dữ liệu như file đính kèm
Bây giờ em muốn sắp xếp các chữ số vào đúng vị trí cột của nó nhưng vẫn giữ nguyên hàng.
Ví dụ: Số 86200 thì xếp vào cột số 8; số 53350 thì xếp vào cột số 5...
Có cách nào làm nhanh việc này được ko ạ, kính nhờ các anh chị hỗ trợ.

Em xin cảm ơn.
 

File đính kèm

CHAOQUAY

Thành viên tích cực
Tham gia ngày
24 Tháng tám 2018
Bài viết
873
Được thích
864
Điểm
360
Kính gửi các anh chị trong diễn đàn
Em có 1 bảng dữ liệu như file đính kèm
Bây giờ em muốn sắp xếp các chữ số vào đúng vị trí cột của nó nhưng vẫn giữ nguyên hàng.
Ví dụ: Số 86200 thì xếp vào cột số 8; số 53350 thì xếp vào cột số 5...
Có cách nào làm nhanh việc này được ko ạ, kính nhờ các anh chị hỗ trợ.

Em xin cảm ơn.
Trong 1 dòng, các đầu số có là duy nhất không bạn?
 

VetMini

Gian hùng bàn phiếm (thành viên trôi nước)
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
7,917
Được thích
9,261
Điểm
560
Số 0 xếp vào cột số nào?
 

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,462
Được thích
2,321
Điểm
360
Kính gửi các anh chị trong diễn đàn
Em có 1 bảng dữ liệu như file đính kèm
Bây giờ em muốn sắp xếp các chữ số vào đúng vị trí cột của nó nhưng vẫn giữ nguyên hàng.
Ví dụ: Số 86200 thì xếp vào cột số 8; số 53350 thì xếp vào cột số 5...
Có cách nào làm nhanh việc này được ko ạ, kính nhờ các anh chị hỗ trợ.

Em xin cảm ơn.
Dùng VBA nhé bạn.
Số 0 xếp vào cột số nào?
Em thấy số 0 cho vào cột à kìa.
 

VetMini

Gian hùng bàn phiếm (thành viên trôi nước)
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
7,917
Được thích
9,261
Điểm
560
Công thức hơi rắc rối mà còn phải copy-paste value.
Vì vậy, cách nhanh nhất là dùng VBA

1. copy dữ liệu vào mảng a
2. tạo mảng b rỗng, có số cột giống mảng a, và số dòng là 10
3. đọc từng dòng mảng a, xét vị trí theo trị và chép lại vào mảng b
4. copy mảng b trở lại bảng tính

Code cho 2 ở trên:
iMax = UBound(a)
jMax = UBound(a, 2)
Redim b(1 To iMax, 1 To 10)

Code cho 3 ở trên tuỳ thuộc vào số của các cột có thứ tự hay không (cột 0 trước 1, trước 2, ...)

Nếu có thứ tự:
For i = 1 To iMax
For j = 1 To jMax
If IsNumeric(a(i, j)) Then
j2 = Val(Left(a(i, j), 1) + 1
b(i, j2) = b(i, j2) & IIF(b(i, j2) = "", "", ", ") & (a(i, j)
End If
Next j
Next i

Nếu không có thứ tự thì lập một chuỗi dò (ví dụ: "1230457689") rồi dùng hàm InStr để lấy vị trí j2
 

VetMini

Gian hùng bàn phiếm (thành viên trôi nước)
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
7,917
Được thích
9,261
Điểm
560
Nếu trùng đầu số thì mình dời nó xuống dòng dưới nhưng đúng cột đó.
Đòi hỏi này sẽ làm cbho code rất rắc rối. Không khó, nhưng rất luộm thuộm.
Mặt khác, nó cũng làm cho bảng kết quả lỗ chỗ như cái lưng da lác lang ben. Trông rất mất cảm tình.

Bạn không tin tôi thì tự làm thử bằng tay một bảng kết quả. Nếu vẫn thấy vừa mắt thì đưa bảng kết quả ấy lên đây, người ta sẽ chỉ cho cách code đúng như vậy.
Hiện tại thì làm mò giùm cho bạn để rồi kết quả lang ben thì phí công quá.
 

ppc0312

whom?
Tham gia ngày
2 Tháng tư 2008
Bài viết
464
Được thích
219
Điểm
710
@chủ topic (chủ câu hỏi tại đây):
Sao lại có bài toán đầu số vậy?
Phải chăng là vui xuân không quên nhiệm vụ: ích nước lợi nhà?
 

phamdoanthang

Thành viên mới
Tham gia ngày
20 Tháng mười hai 2013
Bài viết
21
Được thích
6
Điểm
365
Đòi hỏi này sẽ làm cbho code rất rắc rối. Không khó, nhưng rất luộm thuộm.
Mặt khác, nó cũng làm cho bảng kết quả lỗ chỗ như cái lưng da lác lang ben. Trông rất mất cảm tình.

Bạn không tin tôi thì tự làm thử bằng tay một bảng kết quả. Nếu vẫn thấy vừa mắt thì đưa bảng kết quả ấy lên đây, người ta sẽ chỉ cho cách code đúng như vậy.
Hiện tại thì làm mò giùm cho bạn để rồi kết quả lang ben thì phí công quá.
Nếu vậy thì nhờ bạn viết code sắp xếp các số trong bảng từ trái sang phải theo thứ tự từ nhỏ đến lớn trên 1 dòng giúp mình với.
 

CHAOQUAY

Thành viên tích cực
Tham gia ngày
24 Tháng tám 2018
Bài viết
873
Được thích
864
Điểm
360
Nếu trùng đầu số thì mình dời nó xuống dòng dưới nhưng đúng cột đó.
Chèn thêm sheet, đặt tên là sheet2 rồi chạy thử code dưới đây.
Mã:
Sub sapxep()
Dim Nguon
Dim Sld, Slc, Spt
Dim Kq() As String
Dim i, j, k, x, z
Nguon = Sheet1.Range("A1").CurrentRegion
Sld = UBound(Nguon)
Slc = UBound(Nguon, 2)
ReDim Kq(1 To (Sld - 1) * Slc, 1 To 10)
ReDim Spt(1 To 10)
For i = 2 To Sld
    For j = 1 To Slc
        If Nguon(i, j) <> "" Then
            k = Int(Nguon(i, j) / 10000) + 1
            Spt(k) = Spt(k) + 1
            Kq(Spt(k) + x, k) = Nguon(i, j)
        End If
    Next j
    z = 0
    For j = 1 To 10
        If z < Spt(j) Then z = Spt(j)
        Spt(j) = 0
    Next j
    x = x + z
Next i
With Sheets("Sheet2")
    .UsedRange.Clear
    .Range("A1").Resize(x, UBound(Kq, 2)) = Kq
    .Range("A1").Resize(x, UBound(Kq, 2)).Borders.LineStyle = 1
End With
End Sub
 

HieuCD

Thành viên gạo cội
Tham gia ngày
14 Tháng chín 2010
Bài viết
6,270
Được thích
11,665
Điểm
1,560
Kính gửi các anh chị trong diễn đàn
Em có 1 bảng dữ liệu như file đính kèm
Bây giờ em muốn sắp xếp các chữ số vào đúng vị trí cột của nó nhưng vẫn giữ nguyên hàng.
Ví dụ: Số 86200 thì xếp vào cột số 8; số 53350 thì xếp vào cột số 5...
Có cách nào làm nhanh việc này được ko ạ, kính nhờ các anh chị hỗ trợ.

Em xin cảm ơn.
Insert thêm "Sheet2" rồi chạy code
Mã:
Sub ABC()
  Dim sArr(), Arr() As Boolean, Res() As String
  Dim i&, j&, k&, sRow&, jd&, tmp
 
  ReDim Arr(0 To 99999)
  sArr = Sheet1.UsedRange.Value
  For Each tmp In sArr
    If IsNumeric(tmp) And Len(tmp) = 5 Then
      Arr(tmp) = True
    End If
  Next
  ReDim Res(1 To UBound(sArr) * UBound(sArr, 2), 0 To 9)
  For j = 0 To 9
    jd = j * 10000
    k = 0
    For i = 0 To 9999
      If Arr(jd + i) = True Then
        k = k + 1
        Res(k, j) = Format(jd + i, "00000")
      End If
    Next i
    If sRow < k Then sRow = k
  Next j
  With Sheets("Sheet2")
    .UsedRange.ClearContents
    .Range("A2").Resize(sRow, 10) = Res
  End With
End Sub
 

phamdoanthang

Thành viên mới
Tham gia ngày
20 Tháng mười hai 2013
Bài viết
21
Được thích
6
Điểm
365
Chèn thêm sheet, đặt tên là sheet2 rồi chạy thử code dưới đây.
Mã:
Sub sapxep()
Dim Nguon
Dim Sld, Slc, Spt
Dim Kq() As String
Dim i, j, k, x, z
Nguon = Sheet1.Range("A1").CurrentRegion
Sld = UBound(Nguon)
Slc = UBound(Nguon, 2)
ReDim Kq(1 To (Sld - 1) * Slc, 1 To 10)
ReDim Spt(1 To 10)
For i = 2 To Sld
    For j = 1 To Slc
        If Nguon(i, j) <> "" Then
            k = Int(Nguon(i, j) / 10000) + 1
            Spt(k) = Spt(k) + 1
            Kq(Spt(k) + x, k) = Nguon(i, j)
        End If
    Next j
    z = 0
    For j = 1 To 10
        If z < Spt(j) Then z = Spt(j)
        Spt(j) = 0
    Next j
    x = x + z
Next i
With Sheets("Sheet2")
    .UsedRange.Clear
    .Range("A1").Resize(x, UBound(Kq, 2)) = Kq
    .Range("A1").Resize(x, UBound(Kq, 2)).Borders.LineStyle = 1
End With
End Sub
Mình xin chân thành cảm ơn sự giúp đỡ của bạn, mình đã làm theo và ra kết quả đúng nhưng khi mình nhâp code vào thì lúc ra kết quả nó không giữ được định dạng lúc ban đầu của các con số: ví dụ ban đầu là số 53350 nhưng khi chạy code nó lại chỉ còn 53350 thôi (không có in đậm nữa), bạn có cách nào bổ sung trong lệnh giúp mình được không?
Bài đã được tự động gộp:

Insert thêm "Sheet2" rồi chạy code
Mã:
Sub ABC()
  Dim sArr(), Arr() As Boolean, Res() As String
  Dim i&, j&, k&, sRow&, jd&, tmp

  ReDim Arr(0 To 99999)
  sArr = Sheet1.UsedRange.Value
  For Each tmp In sArr
    If IsNumeric(tmp) And Len(tmp) = 5 Then
      Arr(tmp) = True
    End If
  Next
  ReDim Res(1 To UBound(sArr) * UBound(sArr, 2), 0 To 9)
  For j = 0 To 9
    jd = j * 10000
    k = 0
    For i = 0 To 9999
      If Arr(jd + i) = True Then
        k = k + 1
        Res(k, j) = Format(jd + i, "00000")
      End If
    Next i
    If sRow < k Then sRow = k
  Next j
  With Sheets("Sheet2")
    .UsedRange.ClearContents
    .Range("A2").Resize(sRow, 10) = Res
  End With
End Sub
Em xin chân thành cảm ơn sự giúp đỡ của anh ạ
 
Top Bottom