Xin chào mọi người
Em có 1 vấn đề như sau:
Em muốn lọc tất cả các giá trị có cùng kết quả là 0, 1, 2, 3, 4++ trong các ô số trên ra 1 chuỗi text. Vì khi e làm bôi màu xong, lọc các kết quả có giá trị ví dụ tương ứng với số 0 ở dưới là 00.02.04.05.06... 96.97.98.99 hoặc lọc tương úng với số 3 kết quả là 80.81 thì rất mất tgian và sợ nhầm lẫn
Vậy nên nhờ anh chị giúp đỡ em vấn đề này, sao cho cách làm đơn giản, dễ hiểu 1 chút ạ
Cảm ơn mọi người
Xin chào mọi người
Em có 1 vấn đề như sau:
Em muốn lọc tất cả các giá trị có cùng kết quả là 0, 1, 2, 3, 4++ trong các ô số trên ra 1 chuỗi text. Vì khi e làm bôi màu xong, lọc các kết quả có giá trị ví dụ tương ứng với số 0 ở dưới là 00.02.04.05.06... 96.97.98.99 hoặc lọc tương úng với số 3 kết quả là 80.81 thì rất mất tgian và sợ nhầm lẫn
Vậy nên nhờ anh chị giúp đỡ em vấn đề này, sao cho cách làm đơn giản, dễ hiểu 1 chút ạ
Cảm ơn mọi người
Option Explicit
Sub gpe()
Dim Rng As Range, sRng As Range, WF As Object
Dim fAdd As String, StrC As String
Dim J As Long, Rws As Long, Max_ As Double, Min_ As Double, Col As Byte
Rws = [b2].CurrentRegion.Rows.Count
Col = [b2].CurrentRegion.Columns.Count
For J = 2 To Rws Step 2
If Rng Is Nothing Then
Set Rng = Cells(J, "A").Resize(, Col)
Else
Set Rng = Union(Rng, Cells(J, "A").Resize(, Col))
End If
Next J
Set WF = Application.WorksheetFunction
Min_ = WF.Min(Rng): Max_ = WF.Max(Rng)
' MsgBox Min_ '
For J = Min_ To Max_
Set sRng = Rng.Find(J, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
fAdd = sRng.Address
Do
StrC = StrC & sRng.Offset(-1).Value & ";"
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> fAdd
End If
If Len(StrC) > 1 Then
With [N65500].End(xlUp)
.Offset(1).Value = J
.Offset(1, 1).Value = StrC
StrC = ""
End With
End If
Next J
End Sub
Public Function noi(ByVal Rng As Range, ByVal Tag As Range, Optional ByVal Delimiter As String) As String
Dim SrcArr
Dim i As Long, j As Long
Dim sTmp As String
SrcArr = Rng.Value
For i = 2 To UBound(SrcArr) Step 2
For j = 1 To UBound(SrcArr, 2)
If Len(SrcArr(i, j)) Then
If SrcArr(i, j) = Tag Then
sTmp = sTmp & Delimiter & SrcArr(i - 1, j)
End If
End If
Next j
Next i
If Delimiter <> "" Then
noi = Right(sTmp, Len(sTmp) - 1)
Else
noi = sTmp
End If
End Function=SMALL(IF($A$1:$J$20<>ROWS($1:1)-1;"";IF(MOD(ROW($A$1:$J$20);2);"";(ROW($A$1:$J$20)-2)*[COLOR=#ff0000]10^4[/COLOR]+COLUMN($A$1:$J$20)-1));COLUMNS($A:A))=OFFSET($A$1;INT(pos/[COLOR=#ff0000]10^4[/COLOR]);MOD(pos;[COLOR=#ff0000]10^4[/COLOR]))Public Function noi(ByVal Rng As Range, _
ByVal Tag As Range, _
Optional ByVal Delimiter As String _
) As String
Dim SrcArr, i As Long, j As Long, sTmp As String
SrcArr = Rng.Value
For i = 2 To UBound(SrcArr) Step 2
For j = 1 To UBound(SrcArr, 2)
If SrcArr(i, j) = Tag Then _
sTmp = IIf(sTmp = "", SrcArr(i - 1, j), sTmp & Delimiter & SrcArr(i - 1, j))
Next j
Next i
noi = sTmp
End Function
Đúng rồi tại em sem chưa hết cảm ơn anh nhé!
