Đánh họ và tên, tự động tách tên, tự động viết hoa

[VetMini]

Vác cây đao to này ra chơi chút coi. Cất riết sét hết rồi.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 3 Then
   If Target.Count = 1 Then
      If Target <> "" Then
         Dim temp As String
         temp = Application.Proper(Trim(Target))
         With CreateObject("VbScript.RegExp")
            .Pattern = "(\S+)(.*)(\s\S+)"
            Target(, 2) = .Replace(temp, "$" & 3)
            Target = .Replace(temp, "$" & 1 & "$" & 2)
         End With
      End If
   End If
End If
Application.EnableEvents = True
End Sub

Dao to thiệt. Nếu dùng trong sự kiện worksheet_change thì cứ mỗi lần sự kiện xảy ra thì VBA lại phải gầy một cái Script Object, chạy xong thì xoá nó đi.

Trong các hàm sử dụng liên tục, nếu có cần sử dụng Object phức tạp thì thường người ta dùng biến Static, chỉ phải dựng 1 lần.

 

[Meotom65]

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim Tem, Str As String
If Target.Column = 3 And Target.Count = 1 Then
    Str = Application.WorksheetFunction.Proper(Target)
    Tem = Split(Trim(Str), " ")
    Target.Offset(, 1).Value = Tem(UBound(Tem))
    Target.Value = Trim(Left(Str, Len(Str) - Len(Target.Offset(, 1))))
End If
Application.EnableEvents = True
End Sub

Mình đổi thành Target.Offset(, 0) để nó không tách cột,mà khi viết sai xóa đi viết lại thì bị lỗi này là sao,cám ơn nhiều

 

[Meotom65]

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 3 Then
If Target.Count = 1 Then
If Target <> "" Then
Dim temp As String
temp = Application.Proper(Trim(Target))
With CreateObject("VbScript.RegExp")
.Pattern = "(\S+)(.*)(\s\S+)"
Target(, 2) = .Replace(temp, "$" & 3)
Target = .Replace(temp, "$" & 1 & "$" & 2)
End With
End If
End If
End If
Application.EnableEvents = True
End Sub

Muốn không tách cột thì sửa code thế nào vậy?chỉ giùm cám ơn nha.

 

[duchoian1991]

Mọi người ơi, giờ mình muốn gọp từ 2 cột họ đệm và cột tên thành 1 cột họ tên thì làm thế nào, mình sử dụng hàm ghép xâu thì có tác dụng trong sheet đó chứ ko copy kết quạ họ tên được ạ

 

[gtri]

Muốn không tách cột thì sửa code thế nào vậy?chỉ giùm cám ơn nha.[/COLOR]

Không tách cột có phải là gõ sao y nguyên vậy?

 

[Meotom65]

Không tách cột có phải là gõ sao y nguyên vậy?

Tức là họ và tên ở một cột,chỉ tự động viết hoa thôi .

 

[gtri]

Tức là họ và tên ở một cột,chỉ tự động viết hoa thôi .

Thử sửa thế này xem có đạt không

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 3 Then
If Target.Count = 1 Then
If Target <> "" Then
target = Application.Proper(Trim(Target))
End If
End If
End If
Application.EnableEvents = True
End Sub

 

[khuongvietphong]

===============================================

 

[khuongvietphong]

Nhờ Mod xóa giúp em 2 bài này, em đăng bài hỏi nhưng đã tìm thấy câu trả lời rồi ạ

 

[doatmenhhon]

Thay thành i là được ^^

 

[khoa_pr]

Chào mọi người, Chào Ba tê và quanghai1969
Tôi tham gia mục này quá trể, nhưng đọc mới thấy nên anh em thông cảm.
Sau khi đọc bài viết và code của các bạn tôi có thắc mắc như sau mong các bạn giúp:
Cột D (target.count =1) là cột tách tên. Sau khi tên đã được tách tôi cần sửa lại "Họ" hoặc tên "đệm" rồi nhấn Enter thì nó sẽ xoá mất Tên ở cột D rồi tách tên đệm sang. Điều kiện đặt ra là
1- Nếu cột D rỗng (Target.count = " ") thì tách tên từ cột C sang.
2- Nếu cột D không rỗng (Target.count <> " " ) thì không tách tên từ C sang D.

 

[Meotom65]

Không hiểu bạn nói gì.
Không biết chỗ sửa code, hay code không hoạt động, hay tự động là thế nào? Viết HOA cả HỌ TÊN, hay viết hoa đầu từ, hay gì gì đó nói không rõ ràng mà cứ lòng vòng.

Chào thầy Ba Tê, cho mình hỏi : trong code của thầy muốn tự động viết hoa ở cột 3 và cột 6 cần viết thêm gì ? Cám ơn nhiều ạ.