Gộp dữ liệu từ nhiều cột khác số dòng thành 1 cột (1 người xem)

[doankp]

Hiện mình có bảng dữ liệu với nhiều cột khác nhau, mỗi cột này có số lượng giá trị khác nhau, tức là số dòng chứa giá trị trong mỗi cột là khác nhau.
Nhưng mình chưa biết làm thế nào để gom tất cả các cột đấy thành 1 cột, đồng thời bỏ những giá trị trùng nhau.
Mình có đính kèm file ví dụ, rất mong diễn đàn giúp đỡ!

Xin cảm ơn!

 

[phulien1902]

Hiện mình có bảng dữ liệu với nhiều cột khác nhau, mỗi cột này có số lượng giá trị khác nhau, tức là số dòng chứa giá trị trong mỗi cột là khác nhau.
Nhưng mình chưa biết làm thế nào để gom tất cả các cột đấy thành 1 cột, đồng thời bỏ những giá trị trùng nhau.
Mình có đính kèm file ví dụ, rất mong diễn đàn giúp đỡ!

Xin cảm ơn!

Bạn thử:

Option Explicit
Sub abc()
    Dim j, k, i
    Application.ScreenUpdating = False
    j = 3
    For k = 1 To 3
        For i = 3 To 12
            If Cells(i, k) <> Empty Then
                Cells(j, 7) = Cells(i, k)
                j = j + 1
            End If
        Next i, k
    For i = 3 To Range("G" & Rows.Count).End(xlUp).Row
        If Application.WorksheetFunction.CountIf(Range("G3:G" & i), Range("G" & i)) > 1 Then Range("G" & i).ClearContents
    Next
    Application.ScreenUpdating = True
End Sub

 

[doankp]

Rất cảm ơn bạn,
Nhưng giá trị trùng nhau khi nhập vào cùng 1 cột sẽ chuyển thành 1 ô trống.
Có cách nào bỏ luôn ô trống đó đi và tịnh tiến dữ liệu lên không?

Cảm ơn!

 

[PacificPR]

Rất cảm ơn bạn,
Nhưng giá trị trùng nhau khi nhập vào cùng 1 cột sẽ chuyển thành 1 ô trống.
Có cách nào bỏ luôn ô trống đó đi và tịnh tiến dữ liệu lên không?

Cảm ơn!

Vậy bạn dùng cái này thử

Sub BCA()
    Dim Dic As Object, sArr(), dArr(), I As Long, J As Long, K As Long
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheet1
        sArr = .Range("A3", .Range("A" & Rows.Count).End(xlUp)).Resize(, 3).Value
        ReDim dArr(1 To UBound(sArr, 1) * UBound(sArr, 2), 1 To 1)
        For J = 1 To UBound(sArr, 2)
            For I = 1 To UBound(sArr, 1)
                If sArr(I, J) <> Empty Then
                    If Not Dic.Exists(sArr(I, J)) Then
                        K = K + 1
                        Dic.Add sArr(I, J), K
                        dArr(K, 1) = sArr(I, J)
                    End If
                End If
            Next I
        Next J
        .Range("H3").Resize(K).Resize(5000).ClearContents
        .Range("H3").Resize(K) = dArr
    End With
    Set Dic = Nothing
End Sub

 

[befaint]

gom tất cả các cột đấy thành 1 cột, đồng thời bỏ những giá trị trùng nhau.

 

[ndu96081631]

Hiện mình có bảng dữ liệu với nhiều cột khác nhau, mỗi cột này có số lượng giá trị khác nhau, tức là số dòng chứa giá trị trong mỗi cột là khác nhau.
Nhưng mình chưa biết làm thế nào để gom tất cả các cột đấy thành 1 cột, đồng thời bỏ những giá trị trùng nhau.
Mình có đính kèm file ví dụ, rất mong diễn đàn giúp đỡ!

Xin cảm ơn!

Thử vầy xem:

Function UniqueList(ParamArray sArray())
  Dim Item, tmpArr, SubArr, tmp
  'On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In sArray
      tmpArr = SubArr
      If Not IsArray(tmpArr) Then tmpArr = Array(tmpArr)
      For Each Item In tmpArr
        tmp = CStr(Item)
        If Len(tmp) Then
          If Not .Exists(tmp) Then .Add tmp, ""
        End If
      Next
    Next
    If .Count Then UniqueList = .Keys
  End With
End Function
Sub Main()
  Dim arr
  arr = UniqueList(Sheet1.Range("A3:A1000"), Sheet1.Range("B3:B1000"), Sheet1.Range("C3:C1000"))
  If IsArray(arr) Then
    Sheet1.Range("F3").Resize(UBound(arr) + 1).Value = Application.Transpose(arr)
  End If
End Sub

Chỉ cần chú ý Sub Main và khai báo đầu vào cho đúng là được (code phía trên viết gì kệ nó)

 

[doankp]

Cảm ơn các Bác nhé!