Chưa hiểu chổ tô màu đỏ ---> Vui lòng giải thích lại
Nếu cột A được sort trước (tức những mã giống nhau nằm gần nhau thì bài này có thể dùng công thức như sau
SrcCell =OFFSET(Sheet1!$A$2:$A$1000,MATCH(Sheet1!$E$2,Sheet1!$A$2:$A$1000,0)-1,,COUNTIF(Sheet1!$A$2:$A$1000,Sheet1!$E$2),)Pos =IF(COUNTIF(OFFSET(SrcCell,,1),ROW(Sheet1!$1:$32)-1)=0,ROW(Sheet1!$1:$32)-1,"")=SMALL(Pos,INT(RAND()*COUNT(Pos))+1)Bạn nhắc đến từ "DUY NHẤT" có nghĩa là không muốn TRÙNG, đúng không?
Chưa hình dung rõ lắm
Dù có xem file nhưng cũng chưa hình dung phải làm thế nào ... Vì theo như trong file thì tôi chẳng cần làm gì cả, cứ gõ số 1 vào F2, gõ số 2 vào F3, xong kéo fill đến số 31 thì ngưng
Nếu vầy thì tại cell F2 bạn gõ công thức:
=IF(ROWS($1:1)>COUNT(Pos),"",SMALL(Pos,ROWS($1:1)))
Chứ ý bạn muốn sao? Đã qua 14 bài rồi mà 2 bên vẫn chẳng hiểu nhau... chỉ có thể trách bạn mô tả vấn đề quá kém... Hic...
Nói chưa rõ ràng thì bạn nên đưa kết quả cụ thể (minh họa bằng hình ảnh mà bạn cần làm trong file excel) đôi khi diễn tả bằng chữ viết còn chưa đủ cộng thêm hình ảnh luôn nếu được có video clip càng tốt!...đôi lời cùng You.
Tôi nghĩ Bạn ấy muốn thế này: +Cột H và cột I chỉ là cột phụ cho dễ hiểu theo suy nghĩ của tôi. Cột E là dữ liệu có sẵn (của tác giả)
Đây file của bạn đây! Bạn xem đúng chưa?
Option Explicit
Dim StrC As String: Dim rBD As Long
Const Chu As String = _
"0001020304050607080910111213141516171819202122232425262728293031.."
Const DD As Byte = 70
Sub TimKiem()
Dim sCll As String: Dim jJ As Byte, rKT As Long
Dim Cls As Range, Rg0 As Range, Clls As Range
[d1].Value = "STT": Columns("D:F").Select
Selection.Sort Key1:=[E2], Order1:=xlAscending, Key2:=[D2], _
Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1
[e9].End(xlDown).Offset(1).Value = "@GPE@"
[F1].CurrentRegion.Offset(1, 2).Resize(, 3).ClearContents
For Each Cls In Range([E2], [E65500].End(xlUp))
If sCll <> Cls.Value Then
sCll = Cls.Value
If Cls.Row = 2 Then
rBD = Cls.Row
Else
rKT = Cls.Row: DinhChuoi Cls.Offset(-1).Value
Set Rg0 = Cells(rBD, "E").Resize(rKT - rBD)
jJ = 0
For Each Clls In Rg0.Offset(, 1)
jJ = jJ + 1:
If jJ < Len(StrC) / 2 Then
Clls.Value = Mid(StrC, 2 * jJ - 1, 2)
Else
Clls.Value = "Nothing"
End If
Next Clls
rBD = rKT: rKT = 0
End If
End If
Next Cls
Columns("E:E").Find("@GPE@").Value = ""
End Sub[B]Sub DinhChuoi(SCell As String)[/B]
Dim Rng As Range, sRng As Range, jJ As Byte, MyAdd As String
Const Hh As String = "@@"
Set Rng = Range([A1], [A65500].End(xlUp)): StrC = Chu
Set sRng = Rng.Find(SCell, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
MyAdd = sRng.Address
Do
jJ = 2 * sRng.Offset(, 1).Value + 1
If jJ = 1 Then
StrC = Hh & Mid(StrC, 3, DD)
Else
StrC = Left(StrC, jJ - 1) & Hh & Mid(StrC, jJ + 2, DD)
End If
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
End If
StrC = Replace(StrC, Hh, ""): Cells(rBD, "h").Value = StrC
DaoChuoi StrC: Cells(rBD + 2, "h").Value = StrC
[B]End Sub[/B][B]Sub DaoChuoi(StrC As String)[/B]
Dim jJ As Byte, Vtr As Byte, Num As Byte
Num = Len(StrC) - 2
For jJ = 1 To 99
Randomize: Vtr = 1 + 2 * Int(Num * Rnd)
If Vtr > 9 Then
StrC = Mid(StrC, Vtr, DD) & Mid(StrC, 3, Vtr - 3) & Left(StrC, 2)
Else
StrC = Mid(StrC, Vtr, DD) & Left(StrC, Vtr - 1)
End If
Next jJ
StrC = Replace(StrC, "..", "") & ".."
[B]End Sub[/B]
Nếu muốn vậy thì bạn chỉ thay công thức là: F2=IF(E2="","",IF(ISNA(Pos),RANDBETWEEN(0,31),IF(COUNT(Pos)>=COUNTIF($E$2:$E2,$E2),SMALL(Pos,COUNTIF($E$2:$E2,$E2)),"hết giá trị trong giải 0-31")))
Nếu vậy thì lấy lần lượt từ 0~31 nhé!
