|
Sub TQ()
Dim X%, K%
Dim str As String
K = 1
For X = 2 To Sheet1.Cells(Rows.Count, 2).End(xlUp).Row
If Application.WorksheetFunction.CountIf(Sheet1.Range("B2:B" & X), Sheet1.Cells(X, 2)) = 1 Then
K = K + 1
Sheet1.Cells(X, 2).Copy Sheet2.Cells(K, 1)
ElseIf Application.WorksheetFunction.CountIf(Sheet1.Range("B2:B" & X), Sheet1.Cells(X, 2)) = 2 Then
str = str & Cells(X, 2).Value & ","
End If
Next X
Sheet2.Range("A1") = str
End Sub |
|