Giúp em tối ưu hóa function trong VBA (1 người xem)

[sexy_boys040]

Chào mọi người, em thuộc dân làm website, em muốn chèn thẻ vào trong chuỗi của excel đại khái ý em muốn như sau:

Họ: Nguyễn
Lót: Văn
Tên: Tèo
CMND: 0246....
Địa chỉ: Tp.HCM
ĐT: 01660000....

Sau khi chạy function thì sẽ có kết quả như sau:

<title>Họ</title>
<item>Nguyễn</item>
<title>Lót</title>
<item>Văn</item>
<title>Tên</title>
<item>Tèo</item>
<title>CMND</title>
<item>0246....</item>
<title>Địa chỉ</title>
<item>Tp.HCM</item>
<title>ĐT</title>
<item>01660000....</item>

Em chỉ mới biết sơ xài về VBA, em thấy mấy bác viết sao em bắt chước viết đại công thức function trong Modules như sau, hiểu thì hok dám nhận :

Function ThayThe(cell As Range) As String
        Dim TT
            With CreateObject("VBScript.RegExp")
                cell.Replace ": ", "</title>" + "xuongdong" + "<item>"
                cell.Replace ChrW(10), "</item>" + "xuongdong" + "<title>"
                cell.Replace "xuongdong", ChrW(10)
                TT = "<title>" & cell.Value & "</item>"
            End With
    ThayThe = TT
End Function

Em chạy thì nó kỳ lắm, thường thì khi dùng function, mình Paste Value nó mới ra kết quả, còn đằng này vừa dùng gõ function xog thì ô dữ liệu được chọn bị thay đổi, mặc dù sau đó Paste Value thì ra kết quả đúng, khi wá nhìu dòng thì nó bị treo Excel, em lên đây nhờ các bác chỉ giáo

Em có đính kèm file dưới đây, các bác xem giúp em.

 

[Quang_Hải]

Chào mọi người, em thuộc dân làm website, em muốn chèn thẻ vào trong chuỗi của excel đại khái ý em muốn như sau:

Họ: Nguyễn
Lót: Văn
Tên: Tèo
CMND: 0246....
Địa chỉ: Tp.HCM
ĐT: 01660000....

Sau khi chạy function thì sẽ có kết quả như sau:

<title>Họ</title>
<item>Nguyễn</item>
<title>Lót</title>
<item>Văn</item>
<title>Tên</title>
<item>Tèo</item>
<title>CMND</title>
<item>0246....</item>
<title>Địa chỉ</title>
<item>Tp.HCM</item>
<title>ĐT</title>
<item>01660000....</item>

Em chỉ mới biết sơ xài về VBA, em thấy mấy bác viết sao em bắt chước viết đại công thức function trong Modules như sau, hiểu thì hok dám nhận :

Function ThayThe(cell As Range) As String
        Dim TT
            With CreateObject("VBScript.RegExp")
                cell.Replace ": ", "</title>" + "xuongdong" + "<item>"
                cell.Replace ChrW(10), "</item>" + "xuongdong" + "<title>"
                cell.Replace "xuongdong", ChrW(10)
                TT = "<title>" & cell.Value & "</item>"
            End With
    ThayThe = TT
End Function

Em chạy thì nó kỳ lắm, thường thì khi dùng function, mình Paste Value nó mới ra kết quả, còn đằng này vừa dùng gõ function xog thì ô dữ liệu được chọn bị thay đổi, mặc dù sau đó Paste Value thì ra kết quả đúng, khi wá nhìu dòng thì nó bị treo Excel, em lên đây nhờ các bác chỉ giáo

Em có đính kèm file dưới đây, các bác xem giúp em.

Theo nhìn thấy trong file thì thế này là đủ
Function ThayThe(cell As Range) As String
ThayThe = "<title>" & Left(cell, InStr(cell, ":") - 1) & "<title>"
End Function

 

[sexy_boys040]

Theo nhìn thấy trong file thì thế này là đủ
Function ThayThe(cell As Range) As String
ThayThe = "<title>" & Left(cell, InStr(cell, ":") - 1) & "<title>"
End Function

Bác ơi của em có tới 2 thẻ mà, bác xem lại giúp em , trong 1 ô em có nhìu dòng mà, hok phải 1 dòng

1. <title></title> (cái này cho phần trước dấu
2. <item></item> (cái này cho phần sau dấu

 

[Quang_Hải]

Bác ơi của em có tới 2 thẻ mà, bác xem lại giúp em

1. <title></title> (cái này cho phần trước dấu
2. <item></item> (cái này cho phần sau dấu

ah nhìn không kỹ kết quả, không xem hết nội dung ẩn bên trong ô

 

[sexy_boys040]

Thì mình thấy trong file cột D cho ra kết quả như thế. Phải nhìn thấy kết quả tạm mới viêt được vì công viêc ai nguoi đó hiểu

Bác xem lại giúp em, trong 1 ô có nhìu dòng, hok phải 1 dòng, do em Wrap Text lại

 

[Quang_Hải]

Bác xem lại giúp em, trong 1 ô có nhìu dòng, hok phải 1 dòng, do em Wrap Text lại

Function ThayThe(cell As Range) As String
Dim Tam, i, kq
   Tam = Split(Replace(cell, ChrW(10), ":"), ":")
   For i = 0 To UBound(Tam)
      kq = kq & "<title>" & Trim(Tam(i)) & "</title>" & vbLf
   Next
   ThayThe = kq
End Function

 

[mhung12005]

Chào mọi người, em thuộc dân làm website, em muốn chèn thẻ vào trong chuỗi của excel đại khái ý em muốn như sau:

Họ: Nguyễn
Lót: Văn
Tên: Tèo
CMND: 0246....
Địa chỉ: Tp.HCM
ĐT: 01660000....

Sau khi chạy function thì sẽ có kết quả như sau:

<title>Họ</title>
<item>Nguyễn</item>
<title>Lót</title>
<item>Văn</item>
<title>Tên</title>
<item>Tèo</item>
<title>CMND</title>
<item>0246....</item>
<title>Địa chỉ</title>
<item>Tp.HCM</item>
<title>ĐT</title>
<item>01660000....</item>

Em chỉ mới biết sơ xài về VBA, em thấy mấy bác viết sao em bắt chước viết đại công thức function trong Modules như sau, hiểu thì hok dám nhận :

Function ThayThe(cell As Range) As String
        Dim TT
            With CreateObject("VBScript.RegExp")
                cell.Replace ": ", "</title>" + "xuongdong" + "<item>"
                cell.Replace ChrW(10), "</item>" + "xuongdong" + "<title>"
                cell.Replace "xuongdong", ChrW(10)
                TT = "<title>" & cell.Value & "</item>"
            End With
    ThayThe = TT
End Function

Em chạy thì nó kỳ lắm, thường thì khi dùng function, mình Paste Value nó mới ra kết quả, còn đằng này vừa dùng gõ function xog thì ô dữ liệu được chọn bị thay đổi, mặc dù sau đó Paste Value thì ra kết quả đúng, khi wá nhìu dòng thì nó bị treo Excel, em lên đây nhờ các bác chỉ giáo

Em có đính kèm file dưới đây, các bác xem giúp em.

Bạn thử cái củ chuối này xem:

Function ThayThe(cell As Range) As String   Dim TT, Tmp
      TT = Replace(cell, ChrW(10), "</item>" & ChrW(10) & "<title>", 1, , vbTextCompare)
      Tmp = Replace(TT, ": ", "</title>" & ChrW(10) & "<item>", 1, , vbTextCompare)
      ThayThe = "<title>" & Tmp & "</item>"
End Function

 

[sexy_boys040]

Function ThayThe(cell As Range) As String
Dim Tam, i, kq
   Tam = Split(Replace(cell, ChrW(10), ":"), ":")
   For i = 0 To UBound(Tam)
      kq = kq & "<title>" & Trim(Tam(i)) & "</title>" & vbLf
   Next
   ThayThe = kq
End Function

Cám ơn bác nhìu lắm, nhưng chỉ mới một nửa kết quả thui còn thẻ <item></item> thì phải làm sao hay có cách nào insert left và right của dòng trong 1 cell hok bác, ví dụ dòng chẵn thì em chèn <title></title> và dòng lẻ thì em chèn <item></item>....

 

[mhung12005]

Cám ơn bác nhìu lắm, nhưng chỉ mới một nửa kết quả thui còn thẻ <item></item> thì phải làm sao hay có cách nào insert left và right của dòng trong 1 cell hok bác, ví dụ dòng chẵn thì em chèn <title></title> và dòng lẻ thì em chèn <item></item>....

Bạn đã thử cái "em củ chuối" chưa mình thấy nó ra kết quả giống với bạn yêu cầu đấy.

 

[sexy_boys040]

Bạn đã thử cái "em củ chuối" chưa mình thấy nó ra kết quả giống với bạn yêu cầu đấy.

Cám ơn bạn nhìu lắm, ra kết quả OK, nhưng khi chạy khoảng 100 dòng như vậy hok bik có bị treo máy hok

 

[mhung12005]

Cám ơn bạn nhìu lắm, ra kết quả OK, nhưng khi chạy khoảng 100 dòng như vậy hok bik có bị treo máy hok

Mình đã thử 1500 dòng vẫn dùng được bạn à.

 

[sexy_boys040]

OK vậy là em yên tâm ròi, cám ơn mọi người nhiều lắm, có gì em sẽ hỏi thêm

 

[ptm0412]

Code của tác giả xài lại được, vì thuật toán tốt:

Function ThayThe(cell As Range) As String
        Dim TT
        TT = cell.Value
            TT = Replace(TT, ": ", "</title>" + "xuongdong" + "<item>")
            TT = Replace(TT, ChrW(10), "</item>" + "xuongdong" + "<title>")
            TT = Replace(TT, "xuongdong", ChrW(10))
            TT = "<title>" & TT & "</item>"
    ThayThe = TT
End Function

Đã thử với 1 ô nhiều dòng & nhiều ô