Help, code vba tìm kiếm và thay thế (1 người xem)

thanhduc_iit · 11/9/14

Chào các bác,
Em nhờ các bác code dùm em tìm kiếm và thay thế
Em có gửi file lên và yêu cầu trong đó ạ @$@!^%

Cảm ơn các bác ạ }}}}}

Cá ngừ F1 · 11/9/14

Bạn thử sử dụng code này xem sao:
[GPECODE=vb]Sub ThayThe()
Dim i As Long
With Sheet1
For i = 2 To .[A65000].End(3).Row
If .Cells(i, 1) = "AA" Or .Cells(i, 1) = "BF" Or .Cells(i, 1) = "EC" Then
.Cells(i, 1).Value = "XX"
End If
If .Cells(i, 1) = "TR" Or .Cells(i, 1) = "OP" Or .Cells(i, 1) = "HG" Then
.Cells(i, 1).Value = "YY"
End If
Next
End With
End Sub[/GPECODE]
P/S: trông cái đoạn or ... or hơi nông dân (kiểu mò mẫm)... mong các thành viên khác có giải pháp NGON hơn.

thanhduc_iit · 11/9/14

Cá ngừ F1 đã viết:
Bạn thử sử dụng code này xem sao:
[GPECODE=vb]Sub ThayThe()
Dim i As Long
With Sheet1
For i = 2 To .[A65000].End(3).Row
If .Cells(i, 1) = "AA" Or .Cells(i, 1) = "BF" Or .Cells(i, 1) = "EC" Then
.Cells(i, 1).Value = "XX"
End If
If .Cells(i, 1) = "TR" Or .Cells(i, 1) = "OP" Or .Cells(i, 1) = "HG" Then
.Cells(i, 1).Value = "YY"
End If
Next
End With
End Sub[/GPECODE]
P/S: trông cái đoạn or ... or hơi nông dân (kiểu mò mẫm)... mong các thành viên khác có giải pháp NGON hơn.

Quá đúng yêu cầu rồi bác ạ, cảm ơn bác nhiều /-*+/

ChanhTQ@ · 11/9/14

Giải pháp này vẫn nhanh hơn nè; tuy là thay ngược lại.

PHP:

Sub ThayLai()
 Dim J As Long, Rws As Long, T1 As Long, T2 As Long
 Dim Rng As Range
 
 On Error Resume Next
 Tmr = Timer()
 Rws = [A7].CurrentRegion.Rows.Count
 T1 = 2 + Rws \ 3:            T2 = 2 * Rws \ 3
 
 Set Rng = Cells(1, "A").Resize(T1)
 Rng.Replace What:="XX", Replacement:="AA", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 Rng.Replace What:="YY", Replacement:="TR", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
 Set Rng = Cells(T1, "A").Resize(T1)
 Rng.Replace What:="XX", Replacement:="BF", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 Rng.Replace What:="YY", Replacement:="OP", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 
 Set Rng = Cells(T2, "A").Resize(T1)
 Rng.Replace What:="XX", Replacement:="EC", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 Rng.Replace What:="YY", Replacement:="HG", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 [e4].Value = Timer() - Tmr
End Sub

Quang_Hải · 11/9/14

Cá ngừ F1 đã viết:
Bạn thử sử dụng code này xem sao:
[GPECODE=vb]Sub ThayThe()
Dim i As Long
With Sheet1
For i = 2 To .[A65000].End(3).Row
If .Cells(i, 1) = "AA" Or .Cells(i, 1) = "BF" Or .Cells(i, 1) = "EC" Then
.Cells(i, 1).Value = "XX"
End If
If .Cells(i, 1) = "TR" Or .Cells(i, 1) = "OP" Or .Cells(i, 1) = "HG" Then
.Cells(i, 1).Value = "YY"
End If
Next
End With
End Sub[/GPECODE]
P/S: trông cái đoạn or ... or hơi nông dân (kiểu mò mẫm)... mong các thành viên khác có giải pháp NGON hơn.

Như thế này có lẻ bớt nông dân tẹo, mặc dù ít ai thèm kiểu này

PHP:

Sub thaythe()
Dim data(), i
With Sheet1
   data = .Range(.[A2], .[A65536].End(3)).Value
   For i = 1 To UBound(data)
      Select Case data(i, 1)
      Case "AA", "BF", "EC"
         data(i, 1) = "XX"
      Case "TR", "OP", "HG"
         data(i, 1) = "YY"
      End Select
   Next
   .[A2].Resize(i - 1) = data
End With
End Sub

Cá ngừ F1 · 11/9/14

quanghai1969 đã viết:
Như thế này có lẻ bớt nông dân tẹo, mặc dù ít ai thèm kiểu này

PHP:

Sub thaythe() Dim data(), i With Sheet1 data = .Range(.[A2], .[A65536].End(3)).Value For i = 1 To UBound(data) Select Case data(i, 1) Case "AA", "BF", "EC" data(i, 1) = "XX" Case "TR", "OP", "HG" data(i, 1) = "YY" End Select Next .[A2].Resize(i - 1) = data End With End Sub

Xin phép spam 1 phát.. lâu lắm mới thấy a Hải.. thấy nhớ nhớ kiểu quái chiêu của anh mới chết chứ.. ặc ặc. Chắc dạo này anh bận?
Cơ mà e có đọc cuốn của Kyo thì khuyên dùng if.. end if hơn là select case?

Quang_Hải · 11/9/14

Cá ngừ F1 đã viết:
Xin phép spam 1 phát.. lâu lắm mới thấy a Hải.. thấy nhớ nhớ kiểu quái chiêu của anh mới chết chứ.. ặc ặc. Chắc dạo này anh bận?
Cơ mà e có đọc cuốn của Kyo thì khuyên dùng if.. end if hơn là select case?

Thì đã nói rồi, ít ai thèm kiểu này mà. Lạy trời cho có 1000 lần OR thì biết đá biết vàng

Cá ngừ F1 · 11/9/14

quanghai1969 đã viết:
Thì đã nói rồi, ít ai thèm kiểu này mà. Lạy trời cho có 1000 lần OR thì biết đá biết vàng

Anh nói e mới để ý.. đúng là 1000 lần or thì đi ma teo luôn. Chưa kể đến việc việc thay thế có phân biệt chữ hoa, chữ thường? +-+-+-+

TrungChinhs · 11/9/14

Bạn xem thử cái này

Mã:

Sub Replace()
    For Each cls In Range([a2], [a65000].End(3))
        Range([e2], [e65000].End(3)).Replace cls, cls(1, 2)
    Next
End Sub

thanhduc_iit · 12/9/14

Em đang dùng code của bác Cá Ngừ F1 nhưng với dữ liệu lớn thì nó chạy khá lâu !$@!!

Các code khác thì có cái chạy được, cái k. Hình như chưa đúng yêu cầu ạ

Cá ngừ F1 · 12/9/14

thanhduc_iit đã viết:
Em đang dùng code của bác Cá Ngừ F1 nhưng với dữ liệu lớn thì nó chạy khá lâu

Các code khác thì có cái chạy được, cái k. Hình như chưa đúng yêu cầu ạ

Tốt nhất bạn đưa dữ liệu thật lên. Như thế sẽ có giải pháp tốt hơn.

SA_DQ · 12/9/14

Xài code của Cá ngừ chậm là fải rồi, còn thua cả fương thức Replace!

Em đang dùng code của bác Cá Ngừ F1 nhưng với dữ liệu lớn thì nó chạy khá lâu

Các code khác thì có cái chạy được, cái k. Hình như chưa đúng yêu cầu ạ

Tìm cách đo thòi gian với dữ liệu hàng vạn dòng thì biết ngay thôi. (Chuyện này cũng chỉ mất trên fút gì đó là giả lập được)

Còn Code của Hải thì chưa đề fòng trường hợp trong cột dữ liệu có nhóm từ không cần thay. Lỗi này nếu có, còn là do chủ topic đưa ra iêu cầu không rõ ràng & rốt ráo.

Tóm lại là chủ topic cần nêu vấn đề cụ thể hơn, rằng trong vạn dòng dữ liệu đó có chen những cụm từ không cần thay không?
Chữ hoa/chữ thường nữa, có thể liên quan rằng đó là trường/cột gì của CSDL?

thanhduc_iit · 12/9/14

Em gửi dữ liệu thật lên cho các bác xem ạ. Trong file có yêu cầu cụ thể }}}}}

K phải thay thế tất cả, mà chỉ thay những cái cần thay thôi ạ
Dữ liệu là số nhưng được định dạng dưới dạng TEXT

ChanhTQ@ · 12/9/14

Mình thử với f ương thức Replace

(/ới dữ liệu của bạn, macro chạy < 0.2" (tạm chấp nhận được)

thanhduc_iit · 12/9/14

ChanhTQ@ đã viết:
(/ới dữ liệu của bạn, macro chạy < 0.2" (tạm chấp nhận được)

Cảm ơn bác.
Nhưng khi file đầu vào chỉ có duy nhất 1 cột A thì k thể chạy được.
Dữ liệu của e chỉ có duy nhất cột A thôi ạ, còn mấy cái khác là giải thích để các bác hiểu

ChanhTQ@ · 12/9/14

Cảm ơn bác.
Nhưng khi file đầu vào chỉ có duy nhất 1 cột A thì k thể chạy được.

Vậy là bạn chưa đọc được & diễn dịch ngôn ngữ VBA ra tiếng Việt rồi!
Để mình làm cho vậy nha:

PHP:

Option Explicit
Sub TimVaThayThe()
 Dim SoThay, Cls As Range
 Dim Tmr As Double
 
3 Sheets("ngoai").Select:                    Tmr = Timer()
 
 For Each Cls In Range([E2], [E2].End(xlDown))
5    If Cls.Row < 14 Then SoThay = "'93002" Else SoThay = "'93005"
    Columns("A:A").Replace What:=Cls.Value, Replacement:=SoThay, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
7 Next Cls
 [c1].Value = Timer() - Tmr
End Sub

Các dòng lệnh trên dòng lệnh mang số 3: Khai báo các biến cần dùng

D3 (gòm 2 mệnh đề)
Câu lệnh 1: Chọn trang tính 'Ngoai'
Câu 2: Lấy mốc thời gian hiện tại đưa vô biến Tmr đã khai báo;

D4: Tạo vòng lặp duyệt các ô từ [E2] cho đến dòng cuối của cột [E] có dữ liệu;
Nếu trên trang tính chưa có vùng này thì bạn cần đưa vô;
Nếu không thể đưa vô vùng cột [E] vì lí do nào đó thì fải sửa lại nội dung dòng lệnh này trong macro

D5: Đưa số cần thay thích hợp vô biến 'SoThay', cụ thể khi dòng của ô chưa vượt dòng 14 thì nhận trị đầu, sau đó nhận trị thay thứ hai

D6: Thực hiện fương thức thay toàn bộ trong cột dữ liệu [A]

D7: Kết thúc vòng lặp

D8: Ghi thời gian tiêu tốn của macro vô [C1]

thanhduc_iit · 12/9/14

ChanhTQ@ đã viết:
Vậy là bạn chưa đọc được & diễn dịch ngôn ngữ VBA ra tiếng Việt rồi!
Để mình làm cho vậy nha:

PHP:

Option Explicit Sub TimVaThayThe() Dim SoThay, Cls As Range Dim Tmr As Double 3 Sheets("ngoai").Select: Tmr = Timer() For Each Cls In Range([E2], [E2].End(xlDown)) 5 If Cls.Row < 14 Then SoThay = "'93002" Else SoThay = "'93005" Columns("A:A").Replace What:=Cls.Value, Replacement:=SoThay, LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False 7 Next Cls [c1].Value = Timer() - Tmr End Sub

D4: Tạo vòng lặp duyệt các ô từ [E2] cho đến dòng cuối của cột [E] có dữ liệu;
Nếu trên trang tính chưa có vùng này thì bạn cần đưa vô;
Nếu không thể đưa vô vùng cột [E] vì lí do nào đó thì fải sửa lại nội dung dòng lệnh này trong macro

Vướng ngay chổ này bác ạ. Vì file đưa vào sẽ k có dữ liệu ở cột E

Ba Tê · 12/9/14

thanhduc_iit đã viết:
Vướng ngay chổ này bác ạ. Vì file đưa vào sẽ k có dữ liệu ở cột E

Không đưa vào sao biết cái gì thay bằng cái gì?
Tao 1 sheet khác chứa cái gì thay bằng cái gì như file này xem sao.

Cá ngừ F1 · 12/9/14

thanhduc_iit đã viết:
Vướng ngay chổ này bác ạ. Vì file đưa vào sẽ k có dữ liệu ở cột E

Thì bạn phải chế thêm cột E vào (nên làm thế), chả nhẽ bạn phải nhập tay vào code từng giá trị 1.

thanhduc_iit · 12/9/14

Ba Tê đã viết:
Không đưa vào sao biết cái gì thay bằng cái gì?
Tao 1 sheet khác chứa cái gì thay bằng cái gì như file này xem sao.

Mã:

Sub ThayTheNGOAI()
Dim i As Long
    With Worksheets("NGOAI")
        Tmr = Timer()
        For i = 2 To .UsedRange.Rows.Count
        '-----QUY DOI NOI KCB-----
            'Vi Thuy 93002
            If .Cells(i, 6) = "93048" Or .Cells(i, 6) = "93049" Or .Cells(i, 6) = "93050" Or .Cells(i, 6) = "93051" Or .Cells(i, 6) = "93052" Or .Cells(i, 6) = "93053" Or .Cells(i, 6) = "93054" Or .Cells(i, 6) = "93055" Or .Cells(i, 6) = "93056" Or .Cells(i, 6) = "93057" Or .Cells(i, 6) = "93079" Or .Cells(i, 6) = "93080" Then
                .Cells(i, 6).Value = "'93002"
            End If
             
            'Chau Thanh 93005
            If .Cells(i, 6) = "93026" Or .Cells(i, 6) = "93027" Or .Cells(i, 6) = "93028" Or .Cells(i, 6) = "93029" Or .Cells(i, 6) = "93030" Or .Cells(i, 6) = "93031" Or .Cells(i, 6) = "93032" Or .Cells(i, 6) = "93033" Or .Cells(i, 6) = "93074" Or .Cells(i, 6) = "93087" Or .Cells(i, 6) = "93088" Then
                .Cells(i, 6).Value = "'93005"
            End If
             
        Next
        MsgBox Timer() - Tmr
    End With
End Sub

Do k có dữ liệu cột E nên em đưa vào code như trên thì nó chạy khá làm chậm với dữ liệu lớn !$@!!

Ba Tê · 12/9/14

thanhduc_iit đã viết:
Mã:

Sub ThayTheNGOAI() ..................... End Sub

Do k có dữ liệu cột E nên em đưa vào code như trên thì nó chạy khá làm chậm với dữ liệu lớn

Bài #18 bạn có thể dùng 2 cột thay cái gì bằng cái gì ở sheet khác, hàng ngàn dòng cũng được sao không thử làm, lại muốn đưa hết vào code cho rối mắt và muốn điều chỉnh cũng tìm "lé con mắt"?
Híc!

thanhduc_iit · 12/9/14

Cá ngừ F1 đã viết:
Thì bạn phải chế thêm cột E vào (nên làm thế), chả nhẽ bạn phải nhập tay vào code từng giá trị 1.

Đây cũng là 1 gợi ý hay bác nhỉ --=0

Em nhập tay rất chậm mà dễ bị sai nữa chứ.
Chắc em phải tạo 1 sheet riêng chứa những cái này. Vì k để chung sheet đầu vào đc

thanhduc_iit · 12/9/14

Ba Tê đã viết:
Bài #18 bạn có thể dùng 2 cột thay cái gì bằng cái gì ở sheet khác, hàng ngàn dòng cũng được sao không thử làm, lại muốn đưa hết vào code cho rối mắt và muốn điều chỉnh cũng tìm "lé con mắt"?
Híc!

Dùng cách này của bác nhanh thật.
Em vừa chạy thử cách cũ bằng cách if else if else... thì khoảng 9giây
Còn cách mới dùng sheet tạm thì khoảng 0.04giây --=0

Cảm ơn sự giúp đỡ nhiệt tình của các bác }}}}}

thkd09 · 31/7/15

Nhân tiền chủ đề này, các bác cho em cái code của thay thế này với nhé. Thanks các bác trước.

Miccpro · 2/8/16

Ba Tê đã viết:
Không đưa vào sao biết cái gì thay bằng cái gì?
Tao 1 sheet khác chứa cái gì thay bằng cái gì như file này xem sao.

File bác Ba Tê hay quá, nhưng em có công việc yêu cầu khó hơn, không biết có được không, em đã sửa File bác Ba Tê một tý theo yêu cầu. Mong các bác giúp đỡ

Ba Tê · 2/8/16

Miccpro đã viết:
File bác Ba Tê hay quá, nhưng em có công việc yêu cầu khó hơn, không biết có được không, em đã sửa File bác Ba Tê một tý theo yêu cầu. Mong các bác giúp đỡ

Hên xui nhé. Đẹp thì xui còn xấu thì hên.

PHP:

Public Sub GPE_XYZ()
Dim sArr(), dArr(), tArr(), I As Long, J As Long, N As Long, L As Long
tArr = Sheets("GPE").Range("A2", Sheets("GPE").Range("A2").End(xlDown)).Resize(, 2).Value
With Sheets("ngoai")
    sArr = .Range("A2", .Range("A2").End(xlDown)).Value
    ReDim dArr(1 To UBound(sArr), 1 To 1)
    For I = 1 To UBound(sArr)
        For J = 1 To UBound(tArr)
            N = InStr(sArr(I, 1), tArr(J, 1))
            If N Then
                L = Len(tArr(J, 1))
                dArr(I, 1) = Left(sArr(I, 1), N - 1) & tArr(J, 2) & Mid(sArr(I, 1), N + L, Len(sArr(I, 1)))
                Exit For
            End If
        Next J
    Next I
    .Range("C2").Resize(I - 1) = dArr
End With
End Sub

Miccpro · 3/8/16

Ba Tê đã viết:

Hên xui nhé. Đẹp thì xui còn xấu thì hên.

PHP:

Public Sub GPE_XYZ()
Dim sArr(), dArr(), tArr(), I As Long, J As Long, N As Long, L As Long
tArr = Sheets("GPE").Range("A2", Sheets("GPE").Range("A2").End(xlDown)).Resize(, 2).Value
With Sheets("ngoai")
    sArr = .Range("A2", .Range("A2").End(xlDown)).Value
    ReDim dArr(1 To UBound(sArr), 1 To 1)
    For I = 1 To UBound(sArr)
        For J = 1 To UBound(tArr)
            N = InStr(sArr(I, 1), tArr(J, 1))
            If N Then
                L = Len(tArr(J, 1))
                dArr(I, 1) = Left(sArr(I, 1), N - 1) & tArr(J, 2) & Mid(sArr(I, 1), N + L, Len(sArr(I, 1)))
                Exit For
            End If
        Next J
    Next I
    .Range("C2").Resize(I - 1) = dArr
End With
End Sub

Thanks bác nhiều, cho em hỏi thêm là nếu như không thấy giá trị thay thế ở cột A thì cột C trả về đúng cột A (hiện tại là nếu A có giá trị thay thế thì C=A', nếu không rỗng) được không ạ

Ba Tê · 3/8/16

Miccpro đã viết:
Thanks bác nhiều, cho em hỏi thêm là nếu như không thấy giá trị thay thế ở cột A thì cột C trả về đúng cột A (hiện tại là nếu A có giá trị thay thế thì C=A', nếu không rỗng) được không ạ

Chữa cháy. Thêm 1 dòng này vào trên dòng Next J:

PHP:

..................................................
        If N = 0 Then dArr(I, 1) = sArr(I, 1)
        Next J

Miccpro · 3/8/16

Cảm ơn anh nhiều, hên quá. Chắc tại em xấu @$@!^%

Miccpro · 3/8/16

Ba Tê đã viết:
Chữa cháy. Thêm 1 dòng này vào trên dòng Next J:

PHP:

.................................................. If N = 0 Then dArr(I, 1) = sArr(I, 1) Next J

Em muôn phiền bác thêm tý nữa ạ. Khi nhập liệu ở cột A thì cột B tự chạy chứ không phải click nút "GPE"

phamvankieu92 · 3/8/16

Bạn thử code này:

Sub REPLACE1()
Application.ScreenUpdating = False
With Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
.REPLACE "AA", "XX"
.REPLACE "BF", "XX"
.REPLACE "EC", "XX"
.REPLACE "TR", "YY"
.REPLACE "OP", "YY"
.REPLACE "HG", "YY"
End With
Application.ScreenUpdating = True
End Sub

hoctapphotoshop · 10/1/19

Miccpro đã viết:
Em muôn phiền bác thêm tý nữa ạ. Khi nhập liệu ở cột A thì cột B tự chạy chứ không phải click nút "GPE"

đã tự nhảy, nhưng dữ liệu chuyển bị sai. mong anh chị xem sửa giúp với

Help, code vba tìm kiếm và thay thế (1 người xem)

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

Thành viên chính thức

File đính kèm

( ͡° ͜ʖ ͡°)

Thành viên chính thức

0901452không62

Thành viên gạo cội

( ͡° ͜ʖ ͡°)

Thành viên gạo cội

( ͡° ͜ʖ ͡°)

Thành viên tích cực

File đính kèm

Thành viên chính thức

File đính kèm

( ͡° ͜ʖ ͡°)

/(hông là gì!

Thành viên chính thức

File đính kèm

0901452không62

File đính kèm

Thành viên chính thức

0901452không62

Thành viên chính thức

Cạo Rồi Khỏi Gội

File đính kèm

( ͡° ͜ʖ ͡°)

Thành viên chính thức

Cạo Rồi Khỏi Gội

Thành viên chính thức

Thành viên chính thức

Thành viên mới

File đính kèm

Thành viên thường trực

File đính kèm

Cạo Rồi Khỏi Gội

Thành viên thường trực

Cạo Rồi Khỏi Gội

Thành viên thường trực

Thành viên thường trực

File đính kèm

Thành viên mới

Thành viên mới

File đính kèm

Thời gian đếm ngược.