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

[phamdoanthang]

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.

 

[CHAOQUAY]

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]

Số 0 xếp vào cột số nào?

 

[snow25]

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.

 

[phamdoanthang]

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

Không bạn à, có những lúc nó trùng đầu số của nhau

 

[VetMini]

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

 

[CHAOQUAY]

Không bạn à, có những lúc nó trùng đầu số của nhau

Nếu trùng đầu số thì ghép lại hay là thế nào?

 

[phamdoanthang]

Nếu trùng đầu số thì ghép lại hay là thế nào?

Nếu trùng đầu số thì mình dời nó xuống dòng dưới nhưng đúng cột đó.

 

[VetMini]

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]

@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]

Đò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]

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.

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]

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

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]

Chèn thêm sheet, đặt tên là sheet2 rồi chạy thử code dưới đây.

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: 30/1/20

Insert thêm "Sheet2" rồi chạy code

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 ạ