Thay thế(Replace) nhiều từ thành một từ. . .

zPeterPan · 4/3/21

Em chào các anh chị em. Mọi người cho em hỏi về cách thay thế( Replace) với ạ. . .
ví dụ là:
QW hoặc WQ đổi thành QWxWQ
ER hoặc RE đổi thành ERxRE
TY hoặc YT đổi thành TYxYT
UI hoặc IU đổi thành UIxIU
trong mảng dữ liệu khoảng từ A3:AZ10000
Em có dùng theo cách record macro nhưng khi chạy thì ra kết quả kiểu như này ạ QWxQWxWQ, ERxERxRE,QQxQQxYY .
Nhờ mọi người giúp em code này với ạ. . .
File này là ví dụ thôi ạ

Nhattanktnn · 4/3/21

zPeterPan đã viết:
Em chào các anh chị em. Mọi người cho em hỏi về cách thay thế( Replace) với ạ. . .
ví dụ là:
AB đổi thành ABxBA
CD đổi thành CDxDC
EF đổi thành EFxFE
BA đổi thành ABxBA
DC đổi thành CDxDC
FE đổi thành EFxFE
trong mảng dữ liệu khoảng từ A3:AZ10000
Em có dùng theo cách record macro nhưng khi chạy thì ra kết quả kiểu như này ạ ABxABxBA,CDxCDxDC ,EFxEFxFE .
Nhờ mọi người giúp em code này với ạ. . .
File này là ví dụ thôi ạ

Thử code này xem:

Mã:

Option Explicit

Sub ABC()
Dim sArr(), dArr(), I&, J&, U1&, U2&
With Sheets("Sheet1")
    sArr = .Range("A3:E18").Value
    U1 = UBound(sArr, 1): U2 = UBound(sArr, 2)
    ReDim dArr(1 To U1, 1 To U2)
    For I = 1 To U1
        For J = 1 To U2
            dArr(I, J) = StrReverse(sArr(I, J)) & "x" & sArr(I, J)
        Next
    Next
    .Range("G3").Resize(U1, U2) = dArr
End With
End Sub

zPeterPan · 4/3/21

Nhattanktnn đã viết:

Thử code này xem:

Mã:

Option Explicit

Sub ABC()
Dim sArr(), dArr(), I&, J&, U1&, U2&
With Sheets("Sheet1")
    sArr = .Range("A3:E18").Value
    U1 = UBound(sArr, 1): U2 = UBound(sArr, 2)
    ReDim dArr(1 To U1, 1 To U2)
    For I = 1 To U1
        For J = 1 To U2
            dArr(I, J) = StrReverse(sArr(I, J)) & "x" & sArr(I, J)
        Next
    Next
    .Range("G3").Resize(U1, U2) = dArr
End With
End Sub

Em cảm ơn bác. . . Nếu là giá trị AB thì đổi thành ABxBA , nhưng nếu là AA hoặc BB thì code chạy ra là AAxAA, BBxBB ạ

Nhattanktnn · 4/3/21

zPeterPan đã viết:
nhưng nếu là AA hoặc BB thì code chạy ra là AAxAA, BBxBB ạ

Đây là ý bạn muốn vậy hay đang nói code mình chạy ra như vậy không đúng ý bạn?

befaint · 4/3/21

Function DoiChac(byval strDoi as string) as string
Dim listDoi as variant, listChac as variant, index as long
listDoi = array("AB","CD","EF","BA","DC","FE")
listChac = array("ABxBA", ...)
On error resume next
index = application.match(strDoi, listDoi, 0)
If err.number = 0 then
DoiChac = listChac (index-1)
End if
On error goto 0
End Function

zPeterPan · 4/3/21

Nhattanktnn đã viết:
Đây là ý bạn muốn vậy hay đang nói code mình chạy ra như vậy không đúng ý bạn?

dạ chỗ đấy là không đúng với data ạ. . . phải là (QQxYY, WWxUU, EExII, RRxOO, TTxPP ) thế này cơ ạ

Nhattanktnn · 4/3/21

zPeterPan đã viết:
dạ chỗ đấy là không đúng với data ạ. . . phải là (QQxYY, WWxUU, EExII, RRxOO, TTxPP ) thế này cơ ạ

Thế quy luật chạy ra cái này là như thế nào, hay là do quy ước? nếu là quy ước thì bảng quy ước đâu?

zPeterPan · 4/3/21

befaint đã viết:
Function DoiChac(byval strDoi as string) as string
Dim listDoi as variant, listChac as variant, index as long
listDoi = array("AB","CD","EF","BA","DC","FE")
listChac = array("ABxBA", ...)
On error resume next
index = application.match(strDoi, listDoi, 0)
If err.number = 0 then
DoiChac = listChac (index-1)
End if
On error goto 0
End Function

nếu là "AA" thì mình có phải thêm vào listChac là "AAxBB" phải không ạ

befaint · 4/3/21

zPeterPan đã viết:
nếu là "AA" thì mình có phải thêm vào listChac là "AAxBB" phải không ạ

Đúng rồi.

Bài 1 của bạn. Bạn mô tả rõ quy định đầu vào, đầu ra (bao nhiêu ký tự, điểm gì đặc biệt), quy luật từ vào tới ra như nào?.

Cái đặc biệt là khi đầu vào mà ký tự trước có vị trí trong bảng chữ cái lớn hơn ký tự sau thì làm xyz mình lại bí mật không nói ra.

zPeterPan · 4/3/21

Nhattanktnn đã viết:
Thế quy luật chạy ra cái này là như thế nào, hay là do quy ước? nếu là quy ước thì bảng quy ước đâu?

dạ. . . quy luật là ký tự viết tắt ạ ( Q,W,E,R,T,Y,U,I,O,P) trong đó ( nếu là QQ hoặc YY thì là "QQxYY" , nếu là WW hoặc UU thì là "WWxUU", nếu là EE hoặc II thì là "EExII", nếu là RR hoặc OO thì là "RRxOO", còn nếu là TT hoặc PP thì là "TTxPP" ) đây anh ạ

Bài đã được tự động gộp: 4/3/21

befaint đã viết:
Đúng rồi.

Bài 1 của bạn. Bạn mô tả rõ quy định đầu vào, đầu ra (bao nhiêu ký tự, điểm gì đặc biệt), quy luật từ vào tới ra như nào?.

Cái đặc biệt là khi đầu vào mà ký tự trước có vị trí trong bảng chữ cái lớn hơn ký tự sau thì làm xyz mình lại bí mật không nói ra.

dạ vâng ạ. đây là ký tự viết tắt ạ .bài #10 em có trình bày rồi ạ. . . Ở bài #1 em có kèm theo file đấy ạ. Bác xem giúp em ạ. . .

Nhattanktnn · 4/3/21

zPeterPan đã viết:
Q,W,E,R,T,Y,U,I,O,P

Thế tức là ký tự chỉ có nhiêu đây loại thôi à? A, B đầu bài đâu hết rồi?

zPeterPan · 4/3/21

Nhattanktnn đã viết:
Thế tức là ký tự chỉ có nhiêu đây loại thôi à? A, B đầu bài đâu hết rồi?

dạ vâng ạ. . . A và B là em viết chữ đầu trong bảng chữ cái thôi ạ . . .hề hề

befaint · 4/3/21

zPeterPan đã viết:
quy luật

Đầu vào là "YT" thì ra cái gì bạn?

Nhattanktnn · 4/3/21

zPeterPan đã viết:
dạ vâng ạ. . . A và B là em viết chữ đầu trong bảng chữ cái thôi ạ . . .hề hề

Quất đại rồi tính tiếp:

Mã:

Option Explicit

Sub ABC()
Dim sArr(), dArr(), I&, J&, K&, U1&, U2&, str$
str = ".QQxYY.WWxUU.EExII.RRxOO.TTxPP."
str = Replace(str, ".", "     ") '5 khoang trang
With Sheets("Sheet1")
    sArr = .Range("A3:E18").Value
    U1 = UBound(sArr, 1): U2 = UBound(sArr, 2)
    ReDim dArr(1 To U1, 1 To U2)
    For I = 1 To U1
        For J = 1 To U2
            K = InStr(str, sArr(I, J))
            If K Then
                dArr(I, J) = Trim(Mid(str, K - 5, 10))
            Else
            dArr(I, J) = StrReverse(sArr(I, J)) & "x" & sArr(I, J)
            End If
        Next
    Next
    .Range("G3").Resize(U1, U2) = dArr
End With
End Sub

zPeterPan · 5/3/21

befaint đã viết:
Đầu vào là "YT" thì ra cái gì bạn?

Nếu đầu vào là YT thì sẽ trả lại kết quả là "TY x YT" và TY thì cũng sẽ trả lại là "TY x YT" anh ạ. . .

befaint · 5/3/21

zPeterPan đã viết:
Nếu đầu vào là YT thì sẽ trả lại kết quả là "TY x YT" và TY thì cũng sẽ trả lại là "TY x YT" anh ạ. . .

Chính xác là chỗ đó đó, nhưng bạn có chịu nêu ra đâu. @@

zPeterPan · 5/3/21

befaint đã viết:
Chính xác là chỗ đó đó, nhưng bạn có chịu nêu ra đâu. @@

dạ vâng ạ. . . em không biết cách trình bày ạ. . . em sẽ rút kinh nghiệm ạ. . .

HieuCD · 5/3/21

zPeterPan đã viết:
Em chào các anh chị em. Mọi người cho em hỏi về cách thay thế( Replace) với ạ. . .
ví dụ là:
QW hoặc WQ đổi thành QWxWQ
ER hoặc RE đổi thành ERxRE
TY hoặc YT đổi thành TYxYT
UI hoặc IU đổi thành UIxIU
trong mảng dữ liệu khoảng từ A3:AZ10000
Em có dùng theo cách record macro nhưng khi chạy thì ra kết quả kiểu như này ạ QWxQWxWQ, ERxERxRE,QQxQQxYY .
Nhờ mọi người giúp em code này với ạ. . .
File này là ví dụ thôi ạ

Chạy code

Mã:

Sub ABC()
  Dim sArr(), Res(), i&, j&, k&, sRow&, sCol&, str$, str2$
 
  str = "QQxYY,WWxUU,EExII,RRxOO,TTxPP"
  str2 = "EWQ"
  With Sheets("Sheet1")
    sArr = .Range("A3:E18").Value
    sRow = UBound(sArr, 1): sCol = UBound(sArr, 2)
    ReDim Res(1 To sRow, 1 To sCol)
    For i = 1 To sRow
      For j = 1 To sCol
        tmp = sArr(i, j)
        k = InStr(str, tmp)
        If k Then
          Res(i, j) = Mid(str, Int(k / 6) * 6 + 1, 5)
        Else
          If InStr(1, str2, Mid(tmp, 2, 1)) > InStr(1, str2, Mid(tmp, 1, 1)) Then
            tmp = StrReverse(tmp)
          End If
          Res(i, j) = tmp & "x" & StrReverse(tmp)
        End If
      Next
    Next
    .Range("G3").Resize(sRow, sCol) = Res
  End With
End Sub

zPeterPan · 5/3/21

Nhattanktnn đã viết:

Quất đại rồi tính tiếp:

Mã:

Option Explicit

Sub ABC()
Dim sArr(), dArr(), I&, J&, K&, U1&, U2&, str$
str = ".QQxYY.WWxUU.EExII.RRxOO.TTxPP."
str = Replace(str, ".", "     ") '5 khoang trang
With Sheets("Sheet1")
    sArr = .Range("A3:E18").Value
    U1 = UBound(sArr, 1): U2 = UBound(sArr, 2)
    ReDim dArr(1 To U1, 1 To U2)
    For I = 1 To U1
        For J = 1 To U2
            K = InStr(str, sArr(I, J))
            If K Then
                dArr(I, J) = Trim(Mid(str, K - 5, 10))
            Else
            dArr(I, J) = StrReverse(sArr(I, J)) & "x" & sArr(I, J)
            End If
        Next
    Next
    .Range("G3").Resize(U1, U2) = dArr
End With
End Sub

Em sửa được lỗi ngược rồi ạ. . . nhưng anh cho em hỏi nếu các cột có độ dài khác nhau thì tính bị lỗi ạ

HieuCD đã viết:

Chạy code

Mã:

Sub ABC()
  Dim sArr(), Res(), i&, j&, k&, sRow&, sCol&, str$, str2$

  str = "QQxYY,WWxUU,EExII,RRxOO,TTxPP"
  str2 = "EWQ"
  With Sheets("Sheet1")
    sArr = .Range("A3:E18").Value
    sRow = UBound(sArr, 1): sCol = UBound(sArr, 2)
    ReDim Res(1 To sRow, 1 To sCol)
    For i = 1 To sRow
      For j = 1 To sCol
        tmp = sArr(i, j)
        k = InStr(str, tmp)
        If k Then
          Res(i, j) = Mid(str, Int(k / 6) * 6 + 1, 5)
        Else
          If InStr(1, str2, Mid(tmp, 2, 1)) > InStr(1, str2, Mid(tmp, 1, 1)) Then
            tmp = StrReverse(tmp)
          End If
          Res(i, j) = tmp & "x" & StrReverse(tmp)
        End If
      Next
    Next
    .Range("G3").Resize(sRow, sCol) = Res
  End With
End Sub

Em cảm ơn anh HieuCD. . . Nhưng nếu trường hợp độ dài cột trong mảng không bằng nhau thì kết quả lại những ô trống thì đều cho ra kết quả "QQxYY" anh ạ

HieuCD · 5/3/21

zPeterPan đã viết:
Em sửa được lỗi ngược rồi ạ. . . nhưng anh cho em hỏi nếu các cột có độ dài khác nhau thì tính bị lỗi ạ

View attachment 254902
Em cảm ơn anh HieuCD. . . Nhưng nếu trường hợp độ dài cột trong mảng không bằng nhau thì kết quả lại những ô trống thì đều cho ra kết quả "QQxYY" anh ạ

Them điều kiện loại ô rổng

Mã:

Sub ABC()
  Dim sArr(), Res(), i&, j&, k&, sRow&, sCol&, str$, str2$
 
  str = "QQxYY,WWxUU,EExII,RRxOO,TTxPP"
  str2 = "EWQ"
  With Sheets("Sheet1")
    sArr = .Range("A3:E18").Value
    sRow = UBound(sArr, 1): sCol = UBound(sArr, 2)
    ReDim Res(1 To sRow, 1 To sCol)
    For i = 1 To sRow
      For j = 1 To sCol
        tmp = sArr(i, j)
        If tmp <> Empty Then
          k = InStr(str, tmp)
          If k Then
            Res(i, j) = Mid(str, Int(k / 6) * 6 + 1, 5)
          Else
            If InStr(1, str2, Mid(tmp, 2, 1)) > InStr(1, str2, Mid(tmp, 1, 1)) Then
              tmp = StrReverse(tmp)
            End If
            Res(i, j) = tmp & "x" & StrReverse(tmp)
          End If
        End If
      Next
    Next
    .Range("G3").Resize(sRow, sCol) = Res
  End With
End Sub

Thay thế(Replace) nhiều từ thành một từ. . .

Thành viên hoạt động

File đính kèm

Thành viên gắn bó

Thành viên hoạt động

Thành viên gắn bó

|||||||||||||

Thành viên hoạt động

Thành viên gắn bó

Thành viên hoạt động

|||||||||||||

Thành viên hoạt động

Thành viên gắn bó

Thành viên hoạt động

|||||||||||||

Thành viên gắn bó

Thành viên hoạt động

|||||||||||||

Thành viên hoạt động

Chuyên gia GPE

Thành viên hoạt động

Chuyên gia GPE