Sắp xếp lại các giá trị rời rạc từ cột này sang cột mới có giá trị liền liền nhau

[atutu]

Dear all,
Mình có một vấn đề mà chưa biết cách giải quyết vấn đề này như thế nào:
Xắp xếp lại các giá trị rời rạc từ cột này sang cột mới có giá trị liền liền nhau.
Ở cột A, mình có các giá trị, nhưng các giá trị này nằm không liền nhau, mình muốn xắp xếp lại sang cột B để có được các giá trị liền nhau (kết quả được giống như cột B).

Các bạn giúp mình với ạ, xin chân thành cảm ơn ạ.

 

[nghiaphuc]

Dear all,
Mình có một vấn đề mà chưa biết cách giải quyết vấn đề này như thế nào:
Xắp xếp lại các giá trị rời rạc từ cột này sang cột mới có giá trị liền liền nhau.
Ở cột A, mình có các giá trị, nhưng các giá trị này nằm không liền nhau, mình muốn xắp xếp lại sang cột B để có được các giá trị liền nhau (kết quả được giống như cột B).
View attachment 161756
Các bạn giúp mình với ạ, xin chân thành cảm ơn ạ.

Nếu làm thủ công thì tôi sẽ chọn toàn bộ vùng dữ liệu ở Cột A (từ ô B3 đến hết), nhấn F5, chọn Special, chọn Constants, nhấn OK. Sau đó copy và dán sang Cột B bình thường.

 

[atutu]

Dear,
Có cách nào làm tự động được không ạ?
Thanks.

 

[quanluu]

Dear all,
Mình có một vấn đề mà chưa biết cách giải quyết vấn đề này như thế nào:
Xắp xếp lại các giá trị rời rạc từ cột này sang cột mới có giá trị liền liền nhau.
Ở cột A, mình có các giá trị, nhưng các giá trị này nằm không liền nhau, mình muốn xắp xếp lại sang cột B để có được các giá trị liền nhau (kết quả được giống như cột B).
View attachment 161756
Các bạn giúp mình với ạ, xin chân thành cảm ơn ạ.

Bạn dùng code xem sao

Sub run()
Dim i, k, lr As Integer


    lr = Range("B" & Rows.Count).End(3).Row
    k = 2
    For i = 3 To lr
        If Cells(i, 2) <> "" Then
            k = k + 1
            Cells(k, 4) = Cells(i, 2)
        End If
    Next
    
End Sub

 

[phulien1902]

Dear all,
Mình có một vấn đề mà chưa biết cách giải quyết vấn đề này như thế nào:
Xắp xếp lại các giá trị rời rạc từ cột này sang cột mới có giá trị liền liền nhau.
Ở cột A, mình có các giá trị, nhưng các giá trị này nằm không liền nhau, mình muốn xắp xếp lại sang cột B để có được các giá trị liền nhau (kết quả được giống như cột B).
View attachment 161756
Các bạn giúp mình với ạ, xin chân thành cảm ơn ạ.

Bạn tham khảo:

Sub abc()
    Dim i As Integer
    Dim k As Integer
    For i = 3 To 17
        If Cells(i, 2) <> Empty Then
            k = k + 1
            Cells(k + 2, 4) = Cells(i, 2)
        End If
    Next i
End Sub

 

[nghiaphuc]

Dear,
Có cách nào làm tự động được không ạ?
Thanks.

Tự động thì nó cũng bấy nhiêu đó thôi, khỏi lặp:
[GPECODE=vb]Sub CopyData()
Sheet1.[D365000].Clear 'Xoa du lieu hien co
Sheet1.[B3:B65000].SpecialCells(2).Copy Sheet1.[D3] 'Copy du lieu moi
End Sub[/GPECODE]

 

[Lê Duy Thương]

Tự động thì nó cũng bấy nhiêu đó thôi, khỏi lặp:
[GPECODE=vb]Sub CopyData()
Sheet1.[D365000].Clear 'Xoa du lieu hien co
Sheet1.[B3:B65000].SpecialCells(2).Copy Sheet1.[D3] 'Copy du lieu moi
End Sub[/GPECODE]

vẫn chưa tự động à nha nghĩa phúc
như vầy

Private Sub Worksheet_Activate()    
Sheet1.[D3:D65000].Clear 'Xoa du lieu hien co    
Sheet1.[B3:B65000].SpecialCells(2).Copy Sheet1.[D3] 'Copy du lieu moi
End Sub

hoặc vầy mới tự động ẹc ẹc

Private Sub Workbook_Open()
    Sheet1.[D3:D65000].Clear 'Xoa du lieu hien co
    Sheet1.[B3:B65000].SpecialCells(2).Copy Sheet1.[D3] 'Copy du lieu moi
End Sub

 

[nghiaphuc]

vẫn chưa tự động à nha nghĩa phúc
như vầy

Private Sub Worksheet_Activate()    
Sheet1.[D3:D65000].Clear 'Xoa du lieu hien co    
Sheet1.[B3:B65000].SpecialCells(2).Copy Sheet1.[D3] 'Copy du lieu moi
End Sub

hoặc vầy mới tự động ẹc ẹc

Private Sub Workbook_Open()
    Sheet1.[D3:D65000].Clear 'Xoa du lieu hien co
    Sheet1.[B3:B65000].SpecialCells(2).Copy Sheet1.[D3] 'Copy du lieu moi
End Sub

Vậy vẫn chưa tự động, vì máy của "ngừ ta" đang ở chế độ Disable macro

 

[kid_kaito]

Bạn chọn khoảng E3:E17 rồi nhập công thức =IF(ISERROR(INDEX($B$3:$B$17,SMALL(IFERROR(MATCH($B$3:$B$17,$B$3:$B$17,0),""),ROW(INDIRECT("1:"&COUNTA($B$3:$B$17)))))),"",INDEX($B$3:$B$17,SMALL(IFERROR(MATCH($B$3:$B$17,$B$3:$B$17,0),""),ROW(INDIRECT("1:"&COUNTA($B$3:$B$17))))))

Xong nhấn Ctrl+Shift+Enter.

 

[atutu]

Cảm ơn các bạn rất là nhiều, mình làm được rồi, code của bạn phuclien1902 sử dụng rất hiệu quả và nhanh chóng. Cảm ơn tất cả ạ.

 

[Ba Tê]

Khà Khà...............
2 ông Thương Phúc cứ lo "đấm đá".

...code của bạn phuclien1902 sử dụng rất hiệu quả và nhanh chóng...