Nhờ sửa code VBA (1 người xem)

[swalowbird]

Chào các bác !
Em làm đoạn code sau để phân giải đoạn mã ký tự có trong file đính kèm , nhưng hiện nay em đang bị tắc ở chỗ k =2 , code tuy chạy nhưng không ra kết quả, nhờ các bác sửa code giúp em với , thanks



Sub kkkkkk()
Dim MyString, TargetString As String, Lenth1 As Integer
Dim Rng As Range
Set Rng = Selection
Dim k As Integer
Dim i As Integer
Dim j As Integer
Dim n As Integer
Dim v() As Integer
'dim a as


MyString = Rng
TargetString = "/"
Lenth1 = Len(MyString)
j = 0
For i = 1 To Lenth1
If Mid(MyString, i, 1) = TargetString Then
j = j + 1
End If
Next i
k = j
MsgBox k, , "Thong Bao"


ReDim v(n = 1 To k) As Integer


For i = 1 To Lenth1
If Mid(MyString, i, 1) = TargetString Then
v(n) = i
MsgBox v(n), , "Thong Bao"


End If
Next i


If k = 1 Then


Rng.EntireRow.copy
Rng.Offset(1, 0).EntireRow.insert Shift:=xlDown
Rng.Offset(1, 0) = Mid(MyString, 1, v(n) - 1)




Rng.EntireRow.copy
Rng.Offset(1, 0).EntireRow.insert Shift:=xlDown
Rng.Offset(1, 0) = Mid(MyString, 1, v(n) - (Lenth1 - v(n)) - 1) & Mid(MyString, v(n) + 1, Lenth1 - v(n))


End If


If k = 2 Then


If v(2) - v(1) - 1 = Lenth1 - v(2) Then


Rng.EntireRow.copy
Rng.Offset(1, 0).EntireRow.insert Shift:=xlDown
Rng.Offset(1, 0) = Mid(MyString, 1, v(1) - 1)


Rng.EntireRow.copy
Rng.Offset(1, 0).EntireRow.insert Shift:=xlDown
Rng.Offset(1, 0) = Mid(MyString, 1, v(1) - v(2) + v(1) + 1) & Mid(MyString, v(1) + 1, v(2) - v(1) - 1)


Rng.EntireRow.copy
Rng.Offset(1, 0).EntireRow.insert Shift:=xlDown
Rng.Offset(1, 0) = Mid(MyString, v(2) + 1, Lenth1 - v(2))


End If




End If


End Sub

 

[SA_DQ]

Không có khả năng cách viết hàn lâm như bạn; Mình chỉ là:

Option Explicit
Sub GPE()
Dim MyString, TargetString As String, LenTH1 As Integer
Dim Rng As Range, V() As Integer
Dim K As Integer, I As Integer, J As Integer, N As Integer

Set Rng = Selection
MyString = Rng
TargetString = "/"
LenTH1 = Len(MyString)
J = 0
For I = 1 To LenTH1
    If Mid(MyString, I, 1) = TargetString Then
        J = J + 1
    End If
Next I
K = J
ReDim V(N = 1 To K) As Integer
For I = 1 To LenTH1
    If Mid(MyString, I, 1) = TargetString Then
        V(N) = I
        MsgBox V(N), , "Thong Bao 02"
    End If
Next I

If K = 1 Then
    Rng.EntireRow.Copy
    Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown
    Rng.Offset(1, 0) = Mid(MyString, 1, V(N) - 1)
    Rng.EntireRow.Copy
    Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown
    Rng.Offset(1, 0) = Mid(MyString, 1, V(N) - (LenTH1 - V(N)) - 1) & Mid(MyString, V(N) + 1, LenTH1 - V(N))
End If
If K = 2 Then
    If V(2) - V(1) - 1 = LenTH1 - V(2) Then
        Rng.EntireRow.Copy
        Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown
        Rng.Offset(1, 0) = Mid(MyString, 1, V(1) - 1)
        Rng.EntireRow.Copy
        Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown
        Rng.Offset(1, 0) = Mid(MyString, 1, V(1) - V(2) + V(1) + 1) & Mid(MyString, V(1) + 1, V(2) - V(1) - 1)
        Rng.EntireRow.Copy
        Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown
        Rng.Offset(1, 0) = Mid(MyString, V(2) + 1, LenTH1 - V(2))
    Else
        MsgBox V(2) - V(1) - 1, , LenTH1 - V(2)        '*|*'
    End If
End If
End Sub

Bạn chạy thử xem, chí ít 1 lần duy nhất!

 

[concogia]

Không có khả năng cách viết hàn lâm như bạn; Mình chỉ là:
...
...
Bạn chạy thử xem, chí ít 1 lần duy nhất!

Bạn í muốn làm cái gì trong bài này vậy bác Sa ???

 

[SA_DQ]

Bạn í muốn làm cái gì trong bài này vậy bác Sa ?

Bạn í muốn khi K=2 thì làm vài dòng lệnh trong khuôn khổ

If V(2) - V(1) - 1 = LenTH1 - V(2) Then 
        Rng.EntireRow.Copy 
        Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown 
        Rng.Offset(1, 0) = Mid(MyString, 1, V(1) - 1) 
        Rng.EntireRow.Copy 
        Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown 
        Rng.Offset(1, 0) = Mid(MyString, 1, V(1) - V(2) + V(1) + 1) & Mid(MyString, V(1) + 1, V(2) - V(1) - 1) 
        Rng.EntireRow.Copy 
        Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown 
        Rng.Offset(1, 0) = Mid(MyString, V(2) + 1, LenTH1 - V(2)) 
    Else 
        MsgBox V(2) - V(1) - 1, , LenTH1 - V(2)        '*|*' 
    End If

Nhưng khốn nổi điều kiện If chưa bao giờ thỏa cả, nên bất thành!

 

[swalowbird]

Bác có thể chỉ và sửa code giúp em dc ko ?
Thanks !!!

 

[SA_DQ]

Option Explicit
Sub GPE()
Dim MyString, TargetString As String, LenTH1 As Integer
Dim Rng As Range, Arr() As Integer
Dim K As Integer, I As Integer, J As Integer, N As Integer, W As Byte   '*|*'
Set Rng = Selection
MyString = Rng
TargetString = "/"              'Cái Này Ta Có The Khai Báo 1 Hàng Mà Dùng'
LenTH1 = Len(MyString)
ReDim Arr(1 To LenTH1) As Integer   '*|*'
J = 0
For I = 1 To LenTH1
    If Mid(MyString, I, 1) = TargetString Then
        J = J + 1
    End If
Next I
K = J
For I = 1 To LenTH1
    If Mid(MyString, I, 1) = TargetString Then
        W = W + 1       '*|*'
        Arr(W) = I      '*|*'
        MsgBox Arr(W), , "Thong Bao 02"
    End If
Next I
If K = 1 Then
    Rng.EntireRow.Copy
    Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown
    Rng.Offset(1, 0) = Mid(MyString, 1, Arr(N) - 1)
    Rng.EntireRow.Copy
    Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown
    Rng.Offset(1, 0) = Mid(MyString, 1, Arr(N) - (LenTH1 - Arr(N)) - 1) & Mid(MyString, Arr(N) + 1, LenTH1 - Arr(N))
End If
If K = 2 Then
    If Arr(2) - Arr(1) - 1 = LenTH1 - Arr(2) Then
        Rng.EntireRow.Copy
        Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown
        Rng.Offset(1, 0) = Mid(MyString, 1, Arr(1) - 1)
        Rng.EntireRow.Copy
        Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown
        Rng.Offset(1, 0) = Mid(MyString, 1, Arr(1) - Arr(2) + Arr(1) + 1) & Mid(MyString, Arr(1) + 1, Arr(2) - Arr(1) - 1)
        Rng.EntireRow.Copy
        Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown
        Rng.Offset(1, 0) = Mid(MyString, Arr(2) + 1, LenTH1 - Arr(2))
    Else
        MsgBox Arr(2) - Arr(1) - 1, , LenTH1 - Arr(2)        '*|*'
    End If
End If
Application.CutCopyMode = False     '*|*'
End Sub

 

[swalowbird]

Code của bác gần ra rồi ,
thansk bác nhé !
Có thể cho em xin link fb, em có nhiều vấn đề muốn hỏi ,
Thanks !!!!

 

[SA_DQ]

Code của bác gần ra rồi , thansk bác nhé !
Có thể cho em xin link fb, em có nhiều vấn đề muốn hỏi ,Thanks !!!!

(1) Code của bạn fần lớn mà; Nhưng cơ mà cách viết thì khó ưa!

(2) Thèm vào cái FB gì gì đó của bạn, thà là người cổ lỗ, chứ quyết không xài thứ nớ!

 

[swalowbird]

Em mới tìm hiểu VBA mà

 

[ChanhTQ@]

Em mới tìm hiểu VBA mà

Nếu là thực sự việc bạn mới tìm hiểu VBA thì mình khuyên bạn chọn hướng viết thật tường mình:

Khai báo biến đủ đầy đề xài;
Hai câu lệnh này tiềm ẩn các nguy cơ mà ta có thể tránh bằng cách việt khúc chiết

[FONT=Courier New][COLOR=#0000bb]Set Rng [/COLOR][COLOR=#007700]= [/COLOR][/FONT][FONT=Courier New][COLOR=#0000bb]Selection
 MyString [/COLOR][COLOR=#007700]= [/COLOR][/FONT][COLOR=#0000bb][FONT=Courier New]Rng[/FONT]
[/COLOR]

Tại câu lệnh 1, nếu người dùng chọn 2 ô trong cột thì sao?
Câu lệnh 2 nên là: MyString = Rng.Value
. . . . . . .

Nhìn vô các câu lệnh bạn viết, mình cho là trình VBA của bạn đáng bậc thầy của mình cơ đấy!
Muốn viết nhiều nữa, nhưng chán!

 

[swalowbird]

Cóp nhặt mỗi chỗ 1 ít thôi , Thanks bác nhé !