Giúp em hàm tìm dữ liệu để thay thế sang dữ liệu khác (3 người xem)

[lala_qn]

tạo cho bạn 4 hàm, xem file để tìm hiểu cách dùng từng hàm

dạ ok gần hết rùi a, e F9 kt thì thấy cột i có lúc còn bị mất dữ liệu đó a, xem giúp e với ạ, thanks a !

 

[HieuCD]

dạ ok gần hết rùi a, e F9 kt thì thấy cột i có lúc còn bị mất dữ liệu đó a, xem giúp e với ạ, thanks a !

bạn mở rộng khoảng cách cột I, rồi kiểm tra lại
mình không phát hiện gì

 

[lala_qn]

bạn mở rộng khoảng cách cột I, rồi kiểm tra lại
mình không phát hiện gì

dạ e kéo cột ra xem thì ok hết rùi, e cảm ơn a rất nhiều ạ !

 

[lala_qn]

a HieuCD ơi e thấy trong này còn 1 lỗi nhỏ ạ,
https://www.dropbox.com/s/6hpgvnbq0odrscz/file.ngau.nhien-GPE.xlsm?dl=0
trong file này e thấy kí tự cuối cùng của cell nhập dữ liệu C4 và kí tự cuối cùng của kết quả cell J4 bị mất đi 1 kí tự,
a xem thử nó bị sao ạ, cảm ơn a !

 

[HieuCD]

a HieuCD ơi e thấy trong này còn 1 lỗi nhỏ ạ,
https://www.dropbox.com/s/6hpgvnbq0odrscz/file.ngau.nhien-GPE.xlsm?dl=0
trong file này e thấy kí tự cuối cùng của cell nhập dữ liệu C4 và kí tự cuối cùng của kết quả cell J4 bị mất đi 1 kí tự,
a xem thử nó bị sao ạ, cảm ơn a !

bạn chỉnh lại code

Function PlaceOrder(SourceText, SearchLetter, ReplaceOrderText, DeliText)
Dim i As Long, k As Long, LenSource As Long, ReplaceArr
Dim Result As String
LenSource = Len(SourceText)
ReplacArr = Split(ReplaceOrderText, DeliText)
For i = 1 To LenSource
    If Mid(SourceText, i, 1) = SearchLetter Then
        k = IIf(k <= R, k, 0)
        Result = Result & ReplacArr(k)
        k = k + 1
    Else
        Result = Result & Mid(SourceText, i, 1)
    End If
Next
PlaceOrder = Result
End Function


Function PlaceRandOne(SourceText, SearchLetter, ReplaceRandText, DeliText)
Dim i As Long, k As Long, LenSource As Long, ReplaceArr
Dim Result As String
Application.Volatile (True)
LenSource = Len(SourceText)
ReplacArr = Split(ReplaceRandText, DeliText)
Randomize
k = Rnd() * UBound(ReplacArr)
For i = 1 To LenSource
    If Mid(SourceText, i, 1) = SearchLetter Then
        Result = Result & ReplacArr(k)
    Else
        Result = Result & Mid(SourceText, i, 1)
    End If
Next
PlaceRandOne = Result
End Function


Function PlaceRandPart(SourceText, SearchLetter, ReplaceRandText, DeliText)
Dim i As Long, k As Long, LenSource As Long, R As Long, ReplaceArr
Dim Result As String
Application.Volatile (True)
LenSource = Len(SourceText)
ReplacArr = Split(ReplaceRandText, DeliText)
R = UBound(ReplacArr)
Randomize
k = Rnd() * R
For i = 1 To LenSource
    If Mid(SourceText, i, 1) = SearchLetter Then
        Result = Result & ReplacArr(k)
    Else
        Result = Result & Mid(SourceText, i, 1)
    End If
    If Mid(SourceText, i, 1) = Chr(10) Then k = Rnd() * R
Next
PlaceRandPart = Result
End Function


Function PlaceRand(SourceText, SearchLetter, ReplaceRandText, DeliText)
Dim i As Long, j As Byte, k As Long, LenSource As Long, LenSearch As Long, R As Long, ReplaceArr
Dim Result As String
Application.Volatile (True)
LenSource = Len(SourceText)
LenSearch = Len(SearchLetter)
ReplacArr = Split(ReplaceRandText, DeliText)
R = UBound(ReplacArr)
For i = 1 To LenSource - LenSearch + 1
    If Mid(SourceText, i, LenSearch) = SearchLetter Then
        Randomize
        k = Rnd() * R
        Result = Result & ReplacArr(k)
        i = i + LenSearch - 1
    Else
        Result = Result & Mid(SourceText, i, 1)
        If i = LenSource - LenSearch + 1 Then
          For j = i + 1 To LenSource
            Result = Result & Mid(SourceText, j, 1)
          Next j
        End If
    End If
Next
PlaceRand = Result
End Function

 

[lala_qn]

e vào up lại code nó cứ bảo "out of memory" ko làm dc gì , là bị gì a nhỉ ?

 

[lala_qn]

HieuCD

e up dc code rùi, kiểm tra thấy ok hết rùi, cảm ơn nhiều nhé !

 

[lala_qn]

e hỏi thêm tí a, ở mỗi cell dữ liệu có chia nhiều dòng , vậy ta có đảo ngẫu nhiêu các dòng dữ liệu ở tron các cell đó ko a ?
nếu đc nhờ a đưa ra cột K và có thể tùy chỉnh đảo 5,6,7.... số dòng cần thiết, cảm ơn a !
https://www.dropbox.com/s/xm4hd702dxr3x4x/file.ngau.nhien-GPE.xlsm?dl=0

 

[HieuCD]

e hỏi thêm tí a, ở mỗi cell dữ liệu có chia nhiều dòng , vậy ta có đảo ngẫu nhiêu các dòng dữ liệu ở tron các cell đó ko a ?
nếu đc nhờ a đưa ra cột K và có thể tùy chỉnh đảo 5,6,7.... số dòng cần thiết, cảm ơn a !
https://www.dropbox.com/s/xm4hd702dxr3x4x/file.ngau.nhien-GPE.xlsm?dl=0

bạn dùng Functuon

Function RandRow(SourceText)
Dim Dic As Object, Arr(), Val As Variant, Tmp As Byte, k As Byte, R As Byte
Dim Result As String
Set Dic = CreateObject("scripting.dictionary")
Application.Volatile (True)
Val = Split(SourceText, Chr(10))
R = UBound(Val) + 1
If R = 1 Then Exit Function
ReDim Arr(1 To R)
Randomize
Do
  Tmp = Int(Rnd() * R)
  If Not Dic.exists(Tmp) Then
    k = k + 1
    Dic.Add Tmp, ""
    Arr(k) = Val(Tmp)
  End If
Loop Until k = R
RandRow = Join(Arr, Chr(10))
End Function

chỉnh lại dòng màu đỏ

Function PlaceOrder(SourceText, SearchLetter, ReplaceOrderText, DeliText)
Dim i As Long, k As Long, LenSource As Long, ReplaceArr
Dim Result As String
LenSource = Len(SourceText)
ReplacArr = Split(ReplaceOrderText, DeliText)
For i = 1 To LenSource
    If Mid(SourceText, i, 1) = SearchLetter Then
[COLOR=#ff0000]        k = IIf(k <= UBound(ReplacArr), k, 0)[/COLOR]
        Result = Result & ReplacArr(k)
        k = k + 1
    Else
        Result = Result & Mid(SourceText, i, 1)
    End If
Next
PlaceOrder = Result
End Function

 

[lala_qn]

a HieuCD

cái này ko fai lúc nào e cũng cần đảo các dòng, nên có thể viết code rùi hàm đưa ra đảo 1 cột riêng nào đó ko a nhỉ, và trong hàm có thể tùy chỉnh đổi bao nhiêu dòng cũng dc
như vậy dc ko a nhỉ ?

 

[HieuCD]

a HieuCD

cái này ko fai lúc nào e cũng cần đảo các dòng, nên có thể viết code rùi hàm đưa ra đảo 1 cột riêng nào đó ko a nhỉ, và trong hàm có thể tùy chỉnh đổi bao nhiêu dòng cũng dc
như vậy dc ko a nhỉ ?

là Function nên rất linh hoạt, bạn đặt ở đâu hoặc đảo ô nào cũng được
đổi với số dòng bất kỳ qui định trước chưa tìm được cách

 

[lala_qn]

tức là thêm đoạn code này vào

Function RandRow(SourceText)Dim Dic As Object, Arr(), Val As Variant, Tmp As Byte, k As Byte, R As Byte
Dim Result As String
Set Dic = CreateObject("scripting.dictionary")
Application.Volatile (True)
Val = Split(SourceText, Chr(10))
R = UBound(Val) + 1
If R = 1 Then Exit Function
ReDim Arr(1 To R)
Randomize
Do
Tmp = Int(Rnd() * R)
If Not Dic.exists(Tmp) Then
k = k + 1
Dic.Add Tmp, ""
Arr(k) = Val(Tmp)
End If
Loop Until k = R
RandRow = Join(Arr, Chr(10)) End Function

rùi tìm dòng màu đỏ chỉnh code lại ak a

Function PlaceOrder(SourceText, SearchLetter, ReplaceOrderText, DeliText)Dim i As Long, k As Long, LenSource As Long, ReplaceArr
Dim Result As String
LenSource = Len(SourceText)
ReplacArr = Split(ReplaceOrderText, DeliText)
For i = 1 To LenSource
If Mid(SourceText, i, 1) = SearchLetter Then
k = IIf(k <= UBound(ReplacArr), k, 0)
Result = Result & ReplacArr(k)
k = k + 1
Else
Result = Result & Mid(SourceText, i, 1)
End If
Next
PlaceOrder = Result End Function

 

[HieuCD]

tức là thêm đoạn code này vào
rùi tìm dòng màu đỏ chỉnh code lại ak a

dòng màu đỏ là xác định ký tự không phải dòng
bạn tạo file mới
cho ví dụ, yêu cầu và kết quả cụ thể xem sao

 

[lala_qn]

https://www.dropbox.com/s/xm4hd702dxr3x4x/file.ngau.nhien-GPE.xlsm?dl=0
trong file này e vd cột K đảo a ngẫu nhiên các dòng a nhé, thanks a !

 

[HieuCD]

https://www.dropbox.com/s/xm4hd702dxr3x4x/file.ngau.nhien-GPE.xlsm?dl=0
trong file này e vd cột K đảo a ngẫu nhiên các dòng a nhé, thanks a !

dùng function đã gởi cho bạn

 

[lala_qn]

HieuCD dạ e thấy đảo ok đó a, tại ko để đảo tùy chọn số dòng mình cần nên e muốn hỏi thêm mình có thể viết cho nó đảo ngẩu nhiên tất cả các dòng giữ lại vị trí dòng đầu hoặc dòng cuối ko a ? thanks a !

 

[HieuCD]

HieuCD dạ e thấy đảo ok đó a, tại ko để đảo tùy chọn số dòng mình cần nên e muốn hỏi thêm mình có thể viết cho nó đảo ngẩu nhiên tất cả các dòng giữ lại vị trí dòng đầu hoặc dòng cuối ko a ? thanks a !

bạn liệt kê tất cả khả năng của yêu cầu đảo dòng như thế nào? lúc đó mới hình dung được cấu trúc nhập liệu các tham số của hàm trong công thức

 

[lala_qn]

bạn liệt kê tất cả khả năng của yêu cầu đảo dòng như thế nào? lúc đó mới hình dung được cấu trúc nhập liệu các tham số của hàm trong công thức

dạ e thấy đảo ngẫu nhiên các dòng như a viết là ok rùi ạ,
e nhờ a bổ sung vào trong hàm có thể tủy chỉnh dc 3 trường hợp như thế này ạ
1. Giữ dòng đầu còn lại đảo ngẩu nhiên tất cả các dòng
2. Giữ dòng cuối còn lại đảo ngẫu nhiên tất cả các dòng
3. Đảo ngẫu nhiên tất cả các dòng , thank a ạ!

 

[HieuCD]

dạ e thấy đảo ngẫu nhiên các dòng như a viết là ok rùi ạ,
e nhờ a bổ sung vào trong hàm có thể tủy chỉnh dc 3 trường hợp như thế này ạ
1. Giữ dòng đầu còn lại đảo ngẩu nhiên tất cả các dòng
2. Giữ dòng cuối còn lại đảo ngẫu nhiên tất cả các dòng
3. Đảo ngẫu nhiên tất cả các dòng , thank a ạ!

dùng code mới

Function RandRow(SourceText, Optional Cot As Byte = 0)
Dim Dic As Object, Arr(), Val As Variant, Tmp As Byte, k As Byte, R As Byte, D As Byte
Dim Result As String
Set Dic = CreateObject("scripting.dictionary")
Application.Volatile (True)
Val = Split(SourceText, Chr(10))
R = UBound(Val) + 1
If R = 1 Then Exit Function
ReDim Arr(1 To R)
Randomize
If Cot > 0 Then
  If Cot = 1 Then
    k = 1:  Arr(k) = Val(Tmp):  D = 1
  Else
    Arr(R) = Val(R - 1)
    R = R - 1
  End If
End If
Do
  Tmp = Int(Rnd() * (R - D) + D)
  If Not Dic.exists(Tmp) Then
    k = k + 1
    Dic.Add Tmp, ""
    Arr(k) = Val(Tmp)
  End If
Loop Until k = R
RandRow = Join(Arr, Chr(10))
End Function

nhập công thức theo dạng
đảo tất cả dòng
=RandRow(A4,0)
=RandRow(A4)
đảo từ dòng 2 trở di
=RandRow(A4,1)
đảo từ dòng 1 tới dòng gần cuối
=RandRow(A4,2)

 

[lala_qn]

dùng code mới

Function RandRow(SourceText, Optional Cot As Byte = 0)
Dim Dic As Object, Arr(), Val As Variant, Tmp As Byte, k As Byte, R As Byte, D As Byte
Dim Result As String
Set Dic = CreateObject("scripting.dictionary")
Application.Volatile (True)
Val = Split(SourceText, Chr(10))
R = UBound(Val) + 1
If R = 1 Then Exit Function
ReDim Arr(1 To R)
Randomize
If Cot > 0 Then
  If Cot = 1 Then
    k = 1:  Arr(k) = Val(Tmp):  D = 1
  Else
    Arr(R) = Val(R - 1)
    R = R - 1
  End If
End If
Do
  Tmp = Int(Rnd() * (R - D) + D)
  If Not Dic.exists(Tmp) Then
    k = k + 1
    Dic.Add Tmp, ""
    Arr(k) = Val(Tmp)
  End If
Loop Until k = R
RandRow = Join(Arr, Chr(10))
End Function

nhập công thức theo dạng
đảo tất cả dòng
=RandRow(A4,0)
=RandRow(A4)
đảo từ dòng 2 trở di
=RandRow(A4,1)
đảo từ dòng 1 tới dòng gần cuối
=RandRow(A4,2)

dạ ok hết rùi, làm phiền a quá, cảm ơn a rất nhiều ạ !