Gom dữ liệu từ nhiều cột thành một cột duy nhất.

Thảo luận trong 'Hàm và công thức Excel' bắt đầu bởi xsim_vn, 4 Tháng một 2012.

  1. xsim_vn

    xsim_vn New Member

    Nhờ AE giúp đỡ mình a.!!
    Mình có nhiều cột chứ nội dung là các số
    vd:
    cột A có nội dung là 1,2,3
    cột B có nội dung là 2,3,4
    cột C có nội dung là 5,6,7
    Mình muốn gom nội dung lại thành một cột duy nhất là A chứa 1,2,3,4,5,6,7
    Dùng chức năng copy - dán thì rất lâu ạ..
    Xin cám ơn AE rất nhiều...
     
  2. Lê Duy Thương

    Lê Duy Thương CẠO LẤY GÌ GỘI ?

    chắc dùng tạm code này xem sao
     

    Các file đính kèm:

  3. xsim_vn

    xsim_vn New Member

    chép dán vào rồi bấm RUN phải không vậy bạn??
    Sao nó không chạy nhỉ, nó hiện ra bảng báo lỗi VBA
     
  4. ptm0412

    ptm0412 Excel Ordinary Member

    Code chạy bình thường, ra kết quả đúng. Lại còn sắp xếp lại kết quả nữa.
    Tuy nhiên, câu lệnh sort là VBA 2007, 2010, Excel 2003 chạy sẽ bị lỗi.

    To Lê Duy Thương:

    1. Đối với sort, chỉ cần sort, không cần filter rồi mới sort.

    2. Ngoài ra, đã dùng Dic, sao không gán dic xuống sheet cho khoẻ? hoặc dùng mảng và gán mảng xuống sheet?

    3. Lại còn câu lệnh này: Select từng ô làm chi cho hao tổn thân gầy?

    Mã:
    For Each clls In Range("A1:D" & [A3000].End(3).Row() + 5)
    [COLOR=#ff0000]    clls.Select[/COLOR]
    4. Sửa Application.ScreenUpdating = False sau đó không trả lại như cũ?

    5. Dùng Dic, thì phải xét thêm nếu không rỗng mới add.

    6. Dữ liệu có 4 cột, xét làm chi đến 5 cột từ A đến E?

    7. Kết quả có 1 cột H, xoá làm chi 6 cột từ E đến J?

    Code chỉ cần như vầy:

    PHP:
    Sub SAPXEP()
    Application.ScreenUpdating False
    Sheets
    ("sheet1").Range("H1:H3000").Clear
      Dim clls 
    As RangeDicAs Long
      Set Dic 
    CreateObject("Scripting.Dictionary")
      For 
    Each clls In Range("A1:D" & [A3000].End(3).Row() + 5)
        If 
    Not Dic.Exists(clls.Value) And clls <> "" Then
          Dic
    .Add clls.Value""
          
    1
        End 
    If
      
    Next
    With Range
    ("H6").Resize(i1)
     .
    Value Application.Transpose(Dic.keys)
     .
    Sort Key1:=Range("H6"), Order1:=xlAscendingHeader:=xlNo
    End With
    Application
    .ScreenUpdating True
    End Sub
     
    Lần chỉnh sửa cuối: 4 Tháng một 2012
  5. Lê Duy Thương

    Lê Duy Thương CẠO LẤY GÌ GỘI ?

    cảm ơn sư phụ đã chỉ giáo.xin hỏi thêm sư phụ
    hai hòng lệnh
    Cells(i + 5, "H") = clls.Value và Application.Transpose(Dic.keys) sẽ khác nhau như thế nào
    mà khi đệ tử test thì tốc độ giống nhau
    đã sửa lại
    PHP:
    Sub SAPXEP()
    Application.ScreenUpdating False
    Sheets
    ("sheet1").Range("h3:h60000").Clear
      Dim clls 
    As RangeDicAs Long
      Set Dic 
    CreateObject("Scripting.Dictionary")
      For 
    Each clls In Range("A1:d" & [A60000].End(3).Row() + 5)
        If 
    Not Dic.Exists(clls.ValueThen
          Dic
    .Add clls.Value""
          
    1
          Cells
    (5"H") = clls.Value
           End 
    If
      
    Next
      Range
    ("H6").Sort Key1:=Range("H6"), Order1:=xlAscendingHeader:=xlNo
       Application
    .ScreenUpdating True
    End Sub

     
    Lần chỉnh sửa cuối: 6 Tháng một 2012
  6. ptm0412

    ptm0412 Excel Ordinary Member

    Test thử với 50.000 dòng sẽ thấy khác biệt. Dùng timer để tính thời gian:

    PHP:
    Sub Test()
    Timer
    ...code ...
    Range("H1") = Timer t
    End Sub
     

Chia sẻ trang này