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

lala_qn · 11/2/17

HieuCD đã viết:
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 · 11/2/17

lala_qn đã viết:
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 · 11/2/17

HieuCD đã viết:
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 · 11/2/17

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 · 11/2/17

lala_qn đã viết:
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

Mã:

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 · 11/2/17

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 · 12/2/17

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 · 12/2/17

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 · 12/2/17

lala_qn đã viết:
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

Mã:

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 đỏ

Mã:

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 · 12/2/17

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 · 12/2/17

lala_qn đã viết:
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 · 13/2/17

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 · 13/2/17

lala_qn đã viết:
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 · 13/2/17

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 · 13/2/17

lala_qn đã viết:
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 · 14/2/17

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 · 14/2/17

lala_qn đã viết:
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 · 14/2/17

HieuCD đã viết:
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 · 14/2/17

lala_qn đã viết:
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

Mã:

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 · 14/2/17

HieuCD đã viết:

dùng code mới

Mã:

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 ạ !

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

Người dùng đang xem chủ đề này

Thành viên tiêu biểu

Chuyên gia GPE

Thành viên tiêu biểu

Thành viên tiêu biểu

Chuyên gia GPE

Thành viên tiêu biểu

Thành viên tiêu biểu

Thành viên tiêu biểu

Chuyên gia GPE

Thành viên tiêu biểu

Chuyên gia GPE

Thành viên tiêu biểu

Chuyên gia GPE

Thành viên tiêu biểu

Chuyên gia GPE

File đính kèm

Thành viên tiêu biểu

Chuyên gia GPE

Thành viên tiêu biểu

Chuyên gia GPE

Thành viên tiêu biểu

Đếm ngược thời gian