Mọi người giúp mình chuyển Funtion sang Sub để đảo chuỗi 1 vùng (1 người xem)

[hunglam123]

Xin chào mọi người . Em đang dùng code này để để đảo 1 chuỗi ( Hiện tải chỉ đảo được 1 ô ). nhưng giờ em muốn làm Sub để đổi 1 vùng cho nhanh luôn thì phải sửa code làm sao. Em cảm ơn mọi người ạ

Public Function daochuoi(strText As String) As String
    Dim sReverse As String
    sReverse = StrReverse(strText)
    daochuoi = sReverse
End Function

 

[snow25]

Xin chào mọi người . Em đang dùng code này để để đảo 1 chuỗi ( Hiện tải chỉ đảo được 1 ô ). nhưng giờ em muốn làm Sub để đổi 1 vùng cho nhanh luôn thì phải sửa code làm sao. Em cảm ơn mọi người ạ

Public Function daochuoi(strText As String) As String
    Dim sReverse As String
    sReverse = StrReverse(strText)
    daochuoi = sReverse
End Function

View attachment 234642

Bạn thử.

Function daonguoc(ByVal mang As Range) As Variant
       Dim i As Long, j As Long, kq() As String, arr, s As String, k As Long
       arr = mang.Value
       ReDim kq(1 To UBound(arr), 1 To UBound(arr, 2))
       For i = 1 To UBound(arr)
           For j = 1 To UBound(arr, 2)
            kq(i, j) = StrReverse(arr(i, j))
           Next j
      Next i
      daonguoc = kq
End Function

=daonguoc($C$3:$E$17)

 

[hunglam123]

Bạn thử.

Function daonguoc(ByVal mang As Range) As Variant
       Dim i As Long, j As Long, kq() As String, arr, s As String, k As Long
       arr = mang.Value
       ReDim kq(1 To UBound(arr), 1 To UBound(arr, 2))
       For i = 1 To UBound(arr)
           For j = 1 To UBound(arr, 2)
            kq(i, j) = StrReverse(arr(i, j))
           Next j
      Next i
      daonguoc = kq
End Function

=daonguoc($C$3:$E$17)

dạ em muốn đổi thành Sub để nó ra kết quả Value luôn. Chứ dùng Funciton thì em làm công thức trên 1 bảng tính có vùng A1:Z10000 thì nó chậm lắm anh ạ

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

Bạn thử.

Function daonguoc(ByVal mang As Range) As Variant
       Dim i As Long, j As Long, kq() As String, arr, s As String, k As Long
       arr = mang.Value
       ReDim kq(1 To UBound(arr), 1 To UBound(arr, 2))
       For i = 1 To UBound(arr)
           For j = 1 To UBound(arr, 2)
            kq(i, j) = StrReverse(arr(i, j))
           Next j
      Next i
      daonguoc = kq
End Function

=daonguoc($C$3:$E$17)

mà thôi mình tự xử xong rồi cảm ơn bạn nhiều

Sub daochuoi1vung()
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Col As Long
sArr = Range("C4:E17").Value 'input
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 3) ' 3 COT
For I = 1 To R
    If sArr(I, 1) <> "" Then ' Dk
        K = K + 1
        For Col = 1 To 3 ' 3 COT
            dArr(K, Col) = StrReverse(sArr(I, Col))
        Next Col
    End If
Next I
' OUTPUT
On Error Resume Next
Range("H4:J17").ClearContents
Range("H4").Resize(K, 3) = dArr '
End Sub

 

[VetMini]

Sub LoanXa(byVal Src As Range, byVal Des As Range)
' sub đổi loạn xạ. Yêu cầu rác rưởi cho nên code chả buồn chú thích.
' Src là vùng dữ liệu; Des là ô đầu tiên của vùng kết quả
Dim a
Dim i as long, j as long, iB as long, jB as long
a = Src.Value ' nếu Src chỉ là một ô thì dùng Src.UsedRange.Value
iB = UBound(a,1)
jB = UBound(a,2)
For i = 1 to iB
For j = 1 tojB
a(i, j) = daochuoi(a(i, j))
Next j
Next i
Des.UsedRange.ClearContents
Des.Resize(iB, jB).Value = a
End Sub