tự động nhập nhiều ô có giá trị giống nhau trong một cột thành 1 ô?

[viettuan49a]

em có một bản excel.
cột đầu tiên có nhiều giá trị giống nhau đã được sắp xếp.
em muốn hỏi có macro nào cho tự động nhập các ô có giá trị như nhau thành 1 ô không? mong các cao nhân chỉ giáo

 

[leonguyenz]

Bạn có thể dùng công thức để lọc những giá trị giống nhau. Gõ trừ khóa: "lọc duy nhất" trên thanh Tìm kiếm, GPE sẽ cho nhiều kết quả
http://www.google.com.vn/search?dom...0&submit.y=0&sitesearch=www.giaiphapexcel.com

 

[sealand]

Lần sau khi hỏi phải có ví dụ mẫu nha
Mình đoán ý bạn và viết code sau:

Sub UnionCell()
Dim Rg As Range, Tm, k, i, j, n, m, Vl, Kq()
Set Rg = Sheet1.[A1:D61]
ReDim Kq(1 To Rg.Rows.Count, 1 To Rg.Columns.Count)
i = 1
n = 1
Vl = Rg.Cells(i, 1)
On Error GoTo Thoat
Do
j = Evaluate("=countif(" & Rg.Parent.Name & "!" _
& Rg.Columns(1).Address & ", """ & Vl & """)")
Kq(n, 1) = Trim(Evaluate("=Rept(""" & _
Rg.Cells(i, 1) & """ & char(10)," & j & ")"))
Kq(n, 1) = Left(Kq(n, 1), Len(Kq(n, 1)) - 1)
For k = 2 To Rg.Columns.Count
Tm = WorksheetFunction.Transpose(Rg.Cells(i, k).Resize(j))
Kq(n, k) = Join(Tm, Chr(10))
Next
i = i + j
n = n + 1
Vl = Rg.Cells(i, 1)
Loop
Thoat:
Sheet2.[a1].Resize(n, UBound(Kq, 2)) = Kq
Sheet2.Rows.AutoFit
Sheet2.Select
End Sub

 

[viettuan49a]

Em chỉ muốn nhập các ô của cột đầu thôi, các cột tiếp theo thì để yên như vậy.
Các giá trị sau khi nhập ô thì chỉ còn một giá trị vì nó đã trùng nhau hết rồi, không cần phải để tất cả các giá trị

 

[viettuan49a]

file như sau, mong chỉ giáo

 

[sealand]

Trời ạ, Merge nó lại thôi mà bạn nói loanh quanh mãi.
Code của bạn đây:

Option Explicit
Sub MerCell()
Dim rg As Range, i, j
Set rg = Application.InputBox("Chon cot can Merge (Luu y 1 cot)", , , , , , , 8)
If rg Is Nothing Then
MsgBox "Chua chon cot!!!!"
GoTo thoat
End If
If rg.Columns.Count > 1 Then
MsgBox "Chon nhieu cot the !!!!!"
GoTo thoat
End If
Application.DisplayAlerts = False
rg.VerticalAlignment = xlCenter
i = 1
Do While rg(i) <> ""
j = WorksheetFunction.CountIf(rg.Cells, rg(i))
rg(i).Resize(j).Merge
i = i + j
Loop
thoat:
Application.DisplayAlerts = True
End Sub