[Help] VBA Select 10% trong Storelist

[robinhsoon]

Thân chào cả nhà GPEX.!

Mong cả nhà giúp em một việc ạ...

Hiện tại em có 1 File bao gồm: Store code, Select, Top 10%
Công việc: Em muốn dùng VBA để chọn 10% số lượng storecode với điều kiện cột Select có tích dấu X...
Ví dụ: cột select có tích 20 store thì em sẽ chọn 10% trong 20 store đó và điền kết quả vào cột Top 10%...
Mong cả nhà giúp đỡ... Em chân thành cảm ơn ạ..!

 

[SA_DQ]

Bạn thử cái cùi bắp này xem sao:

Sub Select10FanTram()
Dim Rws As Long, J As Long, W As Long, Tich As Double, Ngau As Integer, Dm As Integer
Dim Chuoi As String
 
Rws = [b1].CurrentRegion.Rows.Count:       Randomize
Tich = Application.WorksheetFunction.CountIf([B2].Resize(Rws), "x")
Ngau = 1 + Tich / 2 * Rnd() \ 1
[C2].Resize(Rws).Clear
For J = 2 To Rws
    If Cells(J, "B").Value = "x" Then
        W = W + 1
        If W >= Ngau Then
            Dm = Dm + 1:                    Cells(J, "C").Value = "Yes"
            Cells(J, "C").Interior.ColorIndex = 34 + J Mod 10
            If Dm > Tich * 0.1 Then Exit Sub
        End If
    End If
Next J
End Sub

 

[robinhsoon]

Bạn thử cái cùi bắp này xem sao:

Sub Select10FanTram()
Dim Rws As Long, J As Long, W As Long, Tich As Double, Ngau As Integer, Dm As Integer
Dim Chuoi As String

Rws = [b1].CurrentRegion.Rows.Count:       Randomize
Tich = Application.WorksheetFunction.CountIf([B2].Resize(Rws), "x")
Ngau = 1 + Tich / 2 * Rnd() \ 1
[C2].Resize(Rws).Clear
For J = 2 To Rws
    If Cells(J, "B").Value = "x" Then
        W = W + 1
        If W >= Ngau Then
            Dm = Dm + 1:                    Cells(J, "C").Value = "Yes"
            Cells(J, "C").Interior.ColorIndex = 34 + J Mod 10
            If Dm > Tich * 0.1 Then Exit Sub
        End If
    End If
Next J
End Sub

Em cảm ơn Thầy đã giúp đỡ em ạ...
Đoạn code đã giải quyết được vấn đề của em ạ...

Cảm ơn Thầy, chúc Thầy sức khỏe và Thành công

Bài đã được tự động gộp: 15/8/18

Bạn thử cái cùi bắp này xem sao:

Sub Select10FanTram()
Dim Rws As Long, J As Long, W As Long, Tich As Double, Ngau As Integer, Dm As Integer
Dim Chuoi As String

Rws = [b1].CurrentRegion.Rows.Count:       Randomize
Tich = Application.WorksheetFunction.CountIf([B2].Resize(Rws), "x")
Ngau = 1 + Tich / 2 * Rnd() \ 1
[C2].Resize(Rws).Clear
For J = 2 To Rws
    If Cells(J, "B").Value = "x" Then
        W = W + 1
        If W >= Ngau Then
            Dm = Dm + 1:                    Cells(J, "C").Value = "Yes"
            Cells(J, "C").Interior.ColorIndex = 34 + J Mod 10
            If Dm > Tich * 0.1 Then Exit Sub
        End If
    End If
Next J
End Sub

Thầy cho em hỏi, Thay vì chọn cột 10% ở 1 cột, giờ em muốn xử lý ở chọn ở 5 - 6 cột thì em sửa vòng lập ở chỗ nào ạ.. Mong Thầy giúp đỡ ạ