Giúp đỡ sửa câu lệnh VBA (7 người xem)

[bebo021999]

Làm đại, hy vọng chiều nay có tin vui thì người giúp cũng trúng!

Option Explicit
Sub Tach()
Dim i&, j&, res(1 To 51, 1 To 1), rng, s
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
rng = Range("B2:K21").Value
For i = 1 To UBound(rng)
    For j = 1 To UBound(rng, 2)
        For Each s In Split(rng(i, j), ",")
            If Not dic.exists(CLng(s)) Then
                dic.Add CLng(s), 1
            Else
                dic(CLng(s)) = dic(CLng(s)) + 1
            End If
        Next
    Next
Next
For i = 0 To 99
    If Not dic.exists(i) Then
        res(1, 1) = IIf(res(1, 1) = "", "", res(1, 1) & ",") & Format(i, "00")
    Else
        res(dic(i) + 1, 1) = IIf(res(dic(i) + 1, 1) = "", "", res(dic(i) + 1, 1) & ",") & Format(i, "00")
    End If
Next
Range("M2").Resize(51, 1).Value = res
End Sub

 

[Quang_Van_Tam]

Làm đại, hy vọng chiều nay có tin vui thì người giúp cũng trúng!

Option Explicit
Sub Tach()
Dim i&, j&, res(1 To 51, 1 To 1), rng, s
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
rng = Range("B2:K21").Value
For i = 1 To UBound(rng)
    For j = 1 To UBound(rng, 2)
        For Each s In Split(rng(i, j), ",")
            If Not dic.exists(CLng(s)) Then
                dic.Add CLng(s), 1
            Else
                dic(CLng(s)) = dic(CLng(s)) + 1
            End If
        Next
    Next
Next
For i = 0 To 99
    If Not dic.exists(i) Then
        res(1, 1) = IIf(res(1, 1) = "", "", res(1, 1) & ",") & Format(i, "00")
    Else
        res(dic(i) + 1, 1) = IIf(res(dic(i) + 1, 1) = "", "", res(dic(i) + 1, 1) & ",") & Format(i, "00")
    End If
Next
Range("M2").Resize(51, 1).Value = res
End Sub

Cảm ơn bác nhiều. Bác có nghiên cứu bộ môn này không?

 

[Quang_Van_Tam]

Làm đại, hy vọng chiều nay có tin vui thì người giúp cũng trúng!

Option Explicit
Sub Tach()
Dim i&, j&, res(1 To 51, 1 To 1), rng, s
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
rng = Range("B2:K21").Value
For i = 1 To UBound(rng)
    For j = 1 To UBound(rng, 2)
        For Each s In Split(rng(i, j), ",")
            If Not dic.exists(CLng(s)) Then
                dic.Add CLng(s), 1
            Else
                dic(CLng(s)) = dic(CLng(s)) + 1
            End If
        Next
    Next
Next
For i = 0 To 99
    If Not dic.exists(i) Then
        res(1, 1) = IIf(res(1, 1) = "", "", res(1, 1) & ",") & Format(i, "00")
    Else
        res(dic(i) + 1, 1) = IIf(res(dic(i) + 1, 1) = "", "", res(dic(i) + 1, 1) & ",") & Format(i, "00")
    End If
Next
Range("M2").Resize(51, 1).Value = res
End Sub

Bác ơi sao chạy nó báo lỗi vậy? file bác gửi giàn mức kia không thấy công thức chỉ thấy số.

 

[bebo021999]

Ah, mình không dùng UDF nhé. code trong sub.
Nhấn nút "play" hoặc F5 để chạy code.
Hoặc tạo button rồi gán code vào cũng được.

 

[Quang_Van_Tam]

Ah, mình không dùng UDF nhé. code trong sub.
Nhấn nút "play" hoặc F5 để chạy code.
Hoặc tạo button rồi gán code vào cũng được.

View attachment 295309

ok. Cảm ơn bác nhiều!

 

[huhumalu]

Làm đại, hy vọng chiều nay có tin vui thì người giúp cũng trúng!

Option Explicit
Sub Tach()
Dim i&, j&, res(1 To 51, 1 To 1), rng, s
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
rng = Range("B2:K21").Value
For i = 1 To UBound(rng)
    For j = 1 To UBound(rng, 2)
        For Each s In Split(rng(i, j), ",")
            If Not dic.exists(CLng(s)) Then
                dic.Add CLng(s), 1
            Else
                dic(CLng(s)) = dic(CLng(s)) + 1
            End If
        Next
    Next
Next
For i = 0 To 99
    If Not dic.exists(i) Then
        res(1, 1) = IIf(res(1, 1) = "", "", res(1, 1) & ",") & Format(i, "00")
    Else
        res(dic(i) + 1, 1) = IIf(res(dic(i) + 1, 1) = "", "", res(dic(i) + 1, 1) & ",") & Format(i, "00")
    End If
Next
Range("M2").Resize(51, 1).Value = res
End Sub

Thật là một công việc "ích nước lợi nhà"

 

[tigertiger]

Làm thế này sao đúng được
Hiện nay còn đủ kiểu các yếu tố âm dương nữa

 

[ptm0412]

Bàn số đề, đánh đề, là vi phạm pháp luật.