Tìm lỗi trong code Tách tên (1 người xem)

hoangdanh282vn · 21/4/08

Chào các bạn.
Nhờ các bạn tìm giúp lỗi trong đoạn code này nha.
Nếu mình dùng 1 dòng for thì chạy tốt, nhưng thêm một dòng nữa để tách lấy Tên lót thì bị lỗi.
Cảm ơn.

Mã:

[COLOR=red]Function tachten(chuoi as string,loai as integer) as string[/COLOR]
[COLOR=red][FONT=Arial]Dim i As Integer[/FONT][/COLOR]
[COLOR=red][FONT=Arial]Dim j As Integer[/FONT][/COLOR]
[COLOR=red][FONT=Arial]ten = Trim(chuoi)[/FONT][/COLOR]
[COLOR=red][FONT=Arial]For i = 1 To Len(ten) Step 1[/FONT][/COLOR]
[COLOR=red][FONT=Arial]For j = Len(ten) To 1 Step -1[/FONT][/COLOR]
[COLOR=red][FONT=Arial]If (Mid(ten, i, 1) = " ") And (Mid(ten, j, 1) = " ") Then[/FONT][/COLOR]
[COLOR=red][FONT=Arial]If loai = "1" Then tachten = Left(ten, i - 1)[/FONT][/COLOR]
[COLOR=red][FONT=Arial]ElseIf loai = "2" Then tachten = Mid(ten, i + 1, j - i - 1)[/FONT][/COLOR]
[COLOR=red][FONT=Arial]ElseIf loai = "3" Then tachten = Right(ten, Len(ten) - j)[/FONT][/COLOR]
[COLOR=red][FONT=Arial]Else: MsgBox "tuy chon chi tu 1 den 3"[/FONT][/COLOR]
[COLOR=red][FONT=Arial]End If[/FONT][/COLOR]
[COLOR=red][FONT=Arial]End If[/FONT][/COLOR]
[COLOR=red][FONT=Arial]End If[/FONT][/COLOR]
[COLOR=red][FONT=Arial]Exit For[/FONT][/COLOR]
[COLOR=red][FONT=Arial]End If[/FONT][/COLOR]
[COLOR=red][FONT=Arial]Next j[/FONT][/COLOR]
[COLOR=red][FONT=Arial]Next i[/FONT][/COLOR]
[COLOR=red][FONT=Arial]End Function

[/FONT][/COLOR]

anhtuan1066 · 21/4/08

Có cãm giác mấy cái IF và FOR lồng vào nhau có vấn đề sao ấy...
Nếu là tôi thì tôi sẽ lấy LOẠI là điều kiện xét đầu tiên...
Nếu loai = 1 thì...
Nếu loại = 2 thì...
Nếu loại = 3 thì...
vân vân...
Chẳng hạn là:

PHP:

Function tachten(chuoi As String, loai As Integer) As String
  Dim i As Integer
  Dim j As Integer
  Ten = Application.WorksheetFunction.Trim(chuoi)
  Select Case loai
    Case Is = 1
      For i = 1 To Len(Ten)
        If Mid(Ten, i, 1) = " " Then tachten = Left(Ten, i - 1): Exit For
      Next i
    Case Is = 2
      For i = 1 To Len(Ten)
        If Mid(Ten, i, 1) = " " Then K1 = i + 1: Exit For
      Next
      For j = Len(Ten) To 1 Step -1
        If Mid(Ten, j, 1) = " " Then K2 = j: Exit For
      Next j
      If K1 >= K2 Then
         tachten = ""
      Else:
         tachten = Mid(Ten, K1, K2 - K1)
      End If
    Case Is = 3
      For j = Len(Ten) To 1 Step -1
        If Mid(Ten, j, 1) = " " Then tachten = Right(Ten, Len(Ten) - j): Exit For
      Next j
  End Select
End Function

MsgBox bạn tự thêm vào!
ANH TUẤN

voda · 21/4/08

Bạn dùng thử hàm này xem. Có thể tách những tên dài không giới hạn số tiếng.

Mã:

Function tachten(ten As String, loai As Integer) As String
 Dim a As Integer, j As Integer
 Dim chuoitach As String, chuoinguyen As String
    chuoinguyen = Trim(ten)
        For j = 1 To Len(chuoinguyen)
             chuoi = Mid(chuoinguyen, j, 1)
            If chuoi <> " " Then
                chuoitach = chuoitach & chuoi
              Else
                 If chuoitach <> "" Then
                  tachten = chuoitach
                  a = a + 1
                  If loai = a Then Exit For
                  chuoitach = ""
                End If
             End If
        Next
     tachten = chuoitach
End Function

anhtuan1066 · 21/4/08

Thầy Voda ơi, code này quả thật rất gọn nhưng nhìn vào code của tác giã em đoán bạn ấy muốn tách họ tên ra thành 3 phần : Họ -- Chử lót -- Tên..
Với code của thầy nếu danh sách có các tên với 3 từ, 4 từ rồi 5 từ lẩn lộn như thì rất khó đạt dc mục đích 1 cách tổng quát...
Ví dụ:
Tachten("Nguyễn Anh Tuấn",1) = "Nguyễn"
Tachten("Nguyễn Anh Tuấn",2) = "Anh"
Tachten("Nguyễn Anh Tuấn",3) = "Tuấn"
Tachten("Nguyễn Hoài Thanh Tri",1) = "Nguyễn
Tachten("Nguyễn Hoài Thanh Tri",2) = "Hoài Thanh"
Tachten("Nguyễn Hoài Thanh Tri",3) = "Tri"
-------------
Mến
ANH TUẤN

ThuNghi · 21/4/08

For i = 1 To Len(ten) Step 1
For j = Len(ten) To 1 Step -1
If (Mid(ten, i, 1) = " ") And (Mid(ten, j, 1) = " ") Then

Bạn thử nghĩ nếu chạy từ đầu - > cuối (i) và chạy từ cuối- >đầu (j)
Như vậy vòng lặp sẽ chạy điên luôn mới thỏa dk
If (Mid(ten, i, 1) = " ") And (Mid(ten, j, 1) = " ")
Ý bạn muốn dùng chung 1 hàm tách theo tham số loại. Như vậy phải phân ra như anhtuan là khá OK nhưng chỉ cần 1 biến i thôi.
Sao không dùng hàm InStr() và InStrRev() trong VBA nhỉ.
Cụ thể như:

PHP:

Function TachTN(chuoi As String, loai As Integer) As String
    Dim FirstName As String, LastName As String, cfName As String
    n = Trim(chuoi)
    Select Case loai
    Case Is = 1
        FirstName = Left(n, InStr(n, " "))
        TachTN = Trim(FirstName)
    Case Is = 2
        LastName = Right(n, Len(n) - InStrRev(n, " "))
        TachTN = Trim(LastName)
    Case Else
        FirstName = Trim(Left(n, InStr(n, " ")))
        LastName = Trim(Right(n, Len(n) - InStrRev(n, " ")))
        TachTN = Trim(Mid(n, Len(FirstName) + 1, Len(n) - Len(LastName) - Len(FirstName)))
    End Select
End Function

voda · 21/4/08

Thêm một cách nữa cho vui:

Mã:

Function tachten(ten As String, loai As Integer) As String
Dim a As Integer, j As Integer
Dim chuoitach As String, chuoinguyen As String, tachten1 As String, tachten2 As String
    chuoinguyen = Trim(ten)
        For j = 1 To Len(chuoinguyen)
             chuoi = Mid(chuoinguyen, j, 1)
            If chuoi <> " " Then
            chuoitach = chuoitach & chuoi
                 ElseIf chuoitach <> "" Then
                    If a = 0 Then
                      tachten1 = chuoitach
                      chuoitach = ""
                    End If
                   a = a + 1
                     If a > 0 Then tachten2 = tachten2 & " " & chuoitach
                      chuoitach = ""
            End If
           Next
     If loai = 1 Then tachten = tachten1
     If loai = 2 Then tachten = Trim(tachten2)
     If loai = 3 Then tachten = chuoitach
End Function

anhtuan1066 · 22/4/08

Code của ThuNghi và thầy Voda hay lắm... tôi cũng sửa lại code trên cho ngắn gọn chút (dù ko hay hơn 2 người)

PHP:

Function Tachten(Chuoi As String, Loai As Integer) As String
  Dim i, j, VT1, VT2 As Integer
  Dim Temp As String
  Temp = Application.WorksheetFunction.Trim(Chuoi)
  For i = 1 To Len(Temp)
    If Mid(Temp, i, 1) = " " Then VT1 = i: Exit For
  Next i
  For j = Len(Temp) To 1 Step -1
    If Mid(Temp, j, 1) = " " Then VT2 = j: Exit For
  Next j
  If VT1 = 0 Then
    Tachten = ""
  Else:
    Select Case Loai
      Case Is = 1
        Tachten = Left(Temp, VT1 - 1)
      Case Is = 2
        If VT1 < VT2 Then
            Tachten = Mid(Temp, VT1 + 1, VT2 - VT1 - 1)
        Else: Tachten = ""
        End If
      Case Is = 3
        Tachten = Right(Temp, Len(Temp) - VT2)
    End Select
  End If
End Function

(2 thằng em InStr() và InStrRev() chắc còn phải ngâm cứu cho thật kỹ mới tùy biến dc...)
--------------------------------------
Và sẳn đây cũng giới thiệu thêm cách làm bằng công thức đúng y chang với thuật toán trên
Đặt name: (giả sử rằng cột A chứa danh sách và con trỏ đang nằm tại dòng thứ 3)

Mã:

Temp =TRIM($A3)

Name này để "làm sạch" các khoảng trắng trước khi vào công việc chính

Mã:

VT1 =MIN(IF(MID(Temp,ROW(INDIRECT("1:"&LEN(Temp))),1)=" ",ROW(INDIRECT("1:"&LEN(Temp))),""))

Name này để lấy vị trí khoảng trắng đầu tiên

Mã:

VT2 =MAX(IF(MID(Temp,ROW(INDIRECT("1:"&LEN(Temp))),1)=" ",ROW(INDIRECT("1:"&LEN(Temp))),""))

Name này để lấy vị trí khoảng trắng cuối cùng
Vậy ta có các công thức:
Ho:

Mã:

=IF(VT1=0,"",LEFT(Temp,VT1-1))

Chử lót:

Mã:

=IF(VT2>VT1,MID(Temp, VT1 + 1, VT2 - VT1 - 1),"")

Tên:

Mã:

=IF(VT1=0,"",RIGHT(Temp,LEN(Temp)-VT2))

Các công thức về tách tên thật ra đã dc đưa lên khá nhiều rồi.. Ở đây tôi ko có tham vọng rằng công thức của mình là ngắn nhất... chỉ đưa lên để cho các bạn so sánh về thuật toán giữa VBA và công thức, xem chúng giống nhau như thế nào... Và cũng nhờ sự so sánh này mà đôi khi làm 1 bài toán nào đó bằng công thức ta cũng có thể nghiệm ra dc cách làm bằng VBA...
Mong dc chỉ giáo thêm!
Mến
ANH TUẤN

SA_DQ · 22/4/08

anhtuan1066 đã viết:
Code của ThuNghi và thầy Voda hay lắm... tôi cũng sửa lại code trên cho ngắn gọn chút (dù ko hay hơn 2 người)

PHP:

Function Tachten(Chuoi As String, Loai As Integer) As String Dim i, j, VT1, VT2 As Integer Dim Temp As String Temp = Application.WorksheetFunction.Trim(Chuoi) For i = 1 To Len(Temp) 1 If Mid(Temp, i, 1) = " " Then VT1 = i: Exit For Next i For j = Len(Temp) To 1 Step -1 2 If Mid(Temp, j, 1) = " " Then VT2 = j: Exit For Next j If VT1 = 0 Then Tachten = "" Else: End If End Function

Câu lệnh 1 & 2 của AnhTuan1066 quá ngắn; nhưng có thể nó không chịu tìm vị trí 1 & 2 tương ứng cho đâu. Mà có khi nó thoát ngay vòng lặp ấy chứ!

Vui một tẹo:
Hai vòng lặp tìm VT1 & VT2 có thể nhốt chung trong 1 vòng lặp được không các bạn. Ví dụ

PHP:

   For i = 1 To Len(Temp)

    If Mid(Temp, i, 1) = " " Then VT1 = i
    If Mid(Temp, Len(Temp) - i, 1) = " " Then VT2 = Len(Temp) - i
    If VT1>0 and VT2 >0 then Exit For

  Next i

anhtuan1066 · 22/4/08

SA_DQ đã viết:
Câu lệnh 1 & 2 của AnhTuan1066 quá ngắn; nhưng có thể nó không chịu tìm vị trí 1 & 2 tương ứng cho đâu. Mà có khi nó thoát ngay vòng lặp ấy chứ!

Ko có đâu anh Sa ơi... em đã thí nghiệm kỹ, có file ở đây nè.. nhưng chẳng biết sao hôm nay ko đính kèm file dc... Hic...

SA_DQ đã viết:
Vui một tẹo:
Hai vòng lặp tìm VT1 & VT2 có thể nhốt chung trong 1 vòng lặp được không các bạn. Ví dụ

PHP:

For i = 1 To Len(Temp) If Mid(Temp, i, 1) = " " Then VT1 = i If Mid(Temp, Len(Temp) - i, 1) = " " Then VT2 = Len(Temp) - i If VT1>0 and VT2 >0 then Exit For Next i

Ai dà... Hay quá... Công thức mình quét có 1 lần mà VBA lại phải quét 2 lần.. Đúng là ngu thật...
Cảm ơn anh Sa!
ANH TUẤN

phamduylong · 22/4/08

Một cách viết khác dùng InStr và InStrRev. Viết lại từ hàm TachTN của ThuNghi để các bạn tham khảo.

Mã:

[COLOR=#0000bb][FONT=Verdana][COLOR=#000000][FONT=Courier New][SIZE=4]Function TachHoTen(chuoi As String, loai As Integer) As String
Dim FirstName As String, LastName As String, cfName As String
chuoi = Application.Trim(chuoi)
If chuoi = "" Then Exit Function
vt1 = InStr(chuoi, " ")
vt2 = InStrRev(chuoi, " ")
Select Case loai
Case 1
  If vt1 = 0 Then Exit Function
  TachHoTen = Left(chuoi, vt1 - 1)
Case 2
  If vt1 = 0 Or vt1 = vt2 Then Exit Function
  TachHoTen = Mid(chuoi, vt1 + 1, vt2 - vt1 - 1)
Case Else
  TachHoTen = Mid(chuoi, vt2 + 1)
End Select
End Function[/SIZE][/FONT]
[/COLOR][/FONT][/COLOR]

hoangdanh282vn · 23/4/08

Các Bác làm hay thật, em học hỏi được rất nhiều về thuật toán.
Chúng ta sẽ cùng nhau ra đề tài và tìm thuật toán thật hay cho đề tài đó để mọi người cùng nhau tiến bộ.
Nhưng em vẫn chưa được biết vòng lặp For lồng nhau của em bị lỗi gì. Theo anh Thunghi thì quét không nổi hay quét bị lỗi? em bít để lần sau khắc phục.
Cãm ơn tất cả mọi người.

SA_DQ · 23/4/08

hoangdanh282vn đã viết:
Nhưng em vẫn chưa được biết vòng lặp For lồng nhau của em bị lỗi gì. Theo anh Thunghi thì quét không nổi hay quét bị lỗi? em bít để lần sau khắc phục. Cãm ơn tất cả mọi người.

PHP:

Function tachten(chuoi as string,loai as integer) as string
 Dim i As Integer
 Dim j As Integer
 ten = Trim(chuoi)
 For i = 1 To Len(ten) Step 1
    For j = Len(ten) To 1 Step -1
 4       If (Mid(ten, i, 1) = " ") And (Mid(ten, j, 1) = " ") Then
            If loai = "1" Then tachten = Left(ten, i - 1)
 6           ElseIf loai = "2" Then tachten = Mid(ten, i + 1, j - i - 1)
 7           ElseIf loai = "3" Then tachten = Right(ten, Len(ten) - j)
        Else: MsgBox "tuy chon chi tu 1 den 3"
        End If
        End If
        End If
        Exit For
        End If
      Next j
 Next i
End Function

1*/ Nếu bạn bắt tay vô viết 1 chương trình hay 1 hàm thì ban đầu nên mang tính chân phương cái đã; Sau khi thử xong & OK mới sửa lại cú pháp cho nó 'hào hoa phong nhã' sau. (Nhiều lần trên diễn đàn mình có đề cập đến vấn đề: Mặc quần áo xong, đàng hoàng rồi mới trang điểm'). Mình thấy nhiều trang tính chưa đâu vô đâu mà đã màu mè lòe loẹt; Lúc đó tìm lỗi cũng khó nữa là!
Quay lại trường hợp của bạn: Bạn trước tiên nên xem câu lệnh 6 & 7
Các ElseIf này nó sẽ không dính dáng đến If ở câu lệnh 5; Vì câu lệnh 5 đã hoàn chỉnh (không cần gì khác nữa);
Như vậy sẽ phải dính đến If ở câu lệnh trước đó;
Tới đây lại đẻ ra vấn đề cú pháp 2 dòng này là sai
Sao bạn không viết

PHP:

 If A<> B then
  . . . . .
 ElseIf A=B then
 . . . . 
 Else
  . . . . . 
 End If

Sau khi test xong & OK rồi thì nếu dòng lệnh IF. . . Else. . . End quá ngắn thì ta chuyển thành

Mã:

If A<>B then A=B Else A=B+1

2*/ Một cái mình thấy cần góp í nữa là sao bạn lại dùng 2 vòng lặp
Bạn dùng 1 vòng lặp mà thôi; Cái này mình viết trên rồi mà, bạn xem lại & áp dụng để giảm thiểu macro chạy vòng vòng trong vòng lặp
Mình giải nghĩa rõ hơn: Nếu bạn khảo sát chuỗi: 'Nguyễn Việt Hồng'
Chương trình của bạn sẽ tìm bằng cách thức sau:
đến chữ 'N'; thực hiện nguyên vòng lặp thứ 2
đến chữ 'g' ; thực hiện nguyên vòng lặp thứ 2
đến chữ 'u' ; thực hiện nguyên vòng lặp thứ 2
. . . .
đến khoảng trắng sau chữ n của chữ Nguyễn ; thực hiện khoảng 4 hay 5 lần gì đó (tùy thuộc vô font chữ của bạn) sẽ đến mục tiêu.
Nếu bạn dùng dòng lệnh như mình nêu ở bài trên, thì chưa hết 1 vòng lặp (như của bạn) là ra kết quả rồi
. . . . .
Thân ái & hữu nghị!

voda · 23/4/08

Hàm của bạn có những hạn chế như bác SA đã góp ý. Tuy nhiên muốn chỉnh cho nó chạy thì viết lại như sau:

Mã:

Function tachten(chuoi As String, loai As Integer) As String
Dim i As Integer
Dim j As Integer
ten = Trim(chuoi)
For i = 1 To Len(ten) Step 1
        For j = Len(ten) To 1 Step -1
                        If (Mid(ten, i, 1) = " ") And (Mid(ten, j, 1) = " ") Then
                                    If loai = 1 Then tachten = Left(ten, i - 1)
                                    If loai = 2 Then tachten = Mid(ten, i + 1, j - i - 1)
                                    If loai = 3 Then tachten = Right(ten, Len(ten) - j)
                                     Exit Function
                         End If
         Next j
Next i
End Function

SA_DQ · 23/4/08

To hoangdanh282vn

Để cho kết quả nhanh hơn với 2 vòng lặp, bạn nên sửa lại như sau

PHP:

Function tachten(chuoi As String, loai As Integer) As String
Dim i As Integer
Dim j As Integer
ten = Trim(chuoi)
For i = 1 To Len(ten) Step 1
   If Mid(ten, i, 1) = " " then   '<<='
        For j = Len(ten) To 1 Step -1
                        If Mid(ten, j, 1) = " " Then   '<<='
                                    If loai = 1 Then tachten = Left(ten, i - 1)
                                    If loai = 2 Then tachten = Mid(ten, i + 1, j - i - 1)
                                    If loai = 3 Then tachten = Right(ten, Len(ten) - j)
                                     Exit Function
                         End If
         Next j
   End If             '<<='
Next i
End Function

adua29 · 8/5/11

cho em hỏi sao nó bắt khai báo biến ten em phải khai báo Dim ten as String nó mới cho chạy

nghiaphuc · 8/5/11

adua29 đã viết:
cho em hỏi sao nó bắt khai báo biến ten em phải khai báo Dim ten as String nó mới cho chạy

Bởi vì trong code trên có sử dụng một số hàm (đi với biến ten) chỉ áp dụng cho kiểu String, chẳng hạn: Trim, Len, Left, Mid, Right.

Tìm lỗi trong code Tách tên (1 người xem)

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

hoangdanh282vn

Nguyễn Cảnh Hoàng Danh

anhtuan1066

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

voda

Thành viên tiêu biểu

anhtuan1066

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

ThuNghi

Hãy cho rồi sẽ nhận!

voda

Thành viên tiêu biểu

anhtuan1066

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

SA_DQ

/(hông là gì!

anhtuan1066

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

phamduylong

-

hoangdanh282vn

Nguyễn Cảnh Hoàng Danh

SA_DQ

/(hông là gì!

voda

Thành viên tiêu biểu

SA_DQ

/(hông là gì!

adua29

Real-life Girls Super Сasual Dating

nghiaphuc

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

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian