Tiếng Việt trong gán giá trị cho ô

[dnphuonganh]

Chào các anh, em đang học VBA theo bài giảng của thầy Hướng trên GPE, có ví dụ sau:
Sub Hocluc()
Sheets(“Sheet1”).Select
Range(“A1”).Select
If ActiveCell >= 8 Then
Range(“B2”).Value = “Học lực giỏi”
ElseIf ActiveCell >= 6.5 Then
Range(“B2”).Value = “Học lực khá”
ElseIf ActiveCell >= 5 Then
Range(“B2”).Value = “Học lực trung bình”
Else
Range(“B2”).Value = “Học lực kém”
End If
End Sub
Cho em hỏi: Tại sao không hiển thị được tiếng Việt trong ô B2 như mong muốn?
Mong các anh giúp đỡ.

 

[anhtuan1066]

Hình như nó chỉ hiển thị tiếng Việt với font ABC thì phải... Font Unicode ko hổ trợ

 

[dnphuonganh]

Thế thì phải làm sao để trong code có được font ABC hở anh?
Như vậy ô B2 bắt buộc phải là font TCVN3 phải không anh?
Em có môt thắc mắc hơi kỳ: VBA cho excel là của Windows mà sao không hỗ trợ unicode??

 

[anhtuan1066]

Tôi cũng ko biết nữa... Nhưng đễ ý từ trước giờ các cao thủ viết code toàn dùng Font ABC, chắc cũng do nguyên nhân này...
Bạn cứ thử với Font ABC thì biết liền chứ gì

 

[dnphuonganh]

Cảm ơn anh anhtuan1066, em làm được rồi. Tức là em chọn font của B2 là TCVN3, gõ dòng chữ trong code bằng bảng mã TCVN3.
Cho em hỏi thêm một chút: Em muốn macro trên tự động chạy (tức là nó tự động điền dòng chữ vào ô B2 khi A1 thay đổi giá trị. Hiện giờ em phải gán macro trên cho một nút bấm. Hình như là phải đưa code vào:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
...
End Sub
Nhưng hễ ta làm thao tác gì với ô bất kỳ nó cũng chạy làm chậm bảng tính.

 

[anhtuan1066]

Đó là tại vì bạn ko giới hạn vùng cho bảng tính... Lý ra nó chỉ tự động chạy trong 1 vùng nào đó thôi, đúng ko?
Ví dụ bạn muốn code tự động chạy khi có sự thay đỗi dữ liệu trong vùng A1 đến A10 thì làm như sau:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("A1:A10"),Target) Is Nothing then
.... Code....
End Sub
Thử xem
ANH TUẤN

 

[anhtuan1066]

Bạn có thể sử dụng code đơn giản sau đây (nhớ copy và paste nó vào Sheet nhé, ko phải Module)

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Range("A1:A10"), Target) Is Nothing Then
    Rw = ActiveCell.Row - 1
    If Cells(Rw, 1).Value >= 8 Then
       Cells(Rw, 2).Value = "Häc lùc giâi"
       ElseIf Cells(Rw, 1).Value >= 6.5 Then
       Cells(Rw, 2).Value = "Häc lùc kh¸"
       ElseIf Cells(Rw, 1).Value >= 5 Then
       Cells(Rw, 2).Value = "Häc lùc trung b×nh"
       Else
       Cells(Rw, 2).Value = "Häc lùc kÐm"
    End If
  End If
End Sub

Đây là code đơn giản, vẫn còn rất nhiều nhược điểm... bạn từ từ nghiêm cứu... Còn nữa... ko dc dùng WorkSheet_SelectionChange mà phải dùng WorkSheet_Change
ANH TUẤN

 

[anhtuan1066]

Các cao thủ giúp thêm lỗi ngay chổ:
1> Xóa cột A: bị lỗi
2> Dòng lệnh: Rw = ActiveCell.Row - 1 chỉ đễ giãi quyết tạm thời... Có ai có hướng nào khác hay hơn ko?
ANH TUẤN

 

[tigertiger]

Các cao thủ giúp thêm lỗi ngay chổ:
1> Xóa cột A: bị lỗi
2> Dòng lệnh: Rw = ActiveCell.Row - 1 chỉ đễ giãi quyết tạm thời... Có ai có hướng nào khác hay hơn ko?
ANH TUẤN

Thế thì dùng hàm là hay nhất , biết sub trên thành hàm ko cần bắt sự kiện WorkSheet_Change làm gì,

Vì hàm sẽ tự động thay đổi khi dữ liệu thay đổi, atuan... ah

 

[anhtuan1066]

Hàm thì dễ rồi... nhưng ở đây là các bạn đang thực tập VBA theo bài giãng của thầy Phan Tự Hướng mà bạn... Có lẽ là đang tập tành nên biến thành Function e rằng vượt quá tầm tay của các bạn ấy... Vã lại nếu là Function thôi thì dùng hàm Excel cho xong (ít nhất là với bài toán này)
Đễ ý code này chỉ chạy khi Enter xuống dòng (dùng phím mũi tên di chuyển sang phải cũng ko chạy)... Xóa cột A gây lỗi tôi nghĩ sửa dễ hơn vụ xác định Row cũng cell vừa nhập liệu... Vậy phải làm sao đây? Tigertiger giúp xem

 

[dnphuonganh]

Cảm ơn anh.
Đoạn code của anh còn một lỗi nữa (mong anh thông cảm)
Nếu ta nháy đúp vào một ô trong vùng A1:A10 thì ở B... tương ứng cũng điền Học lực kém. (Tức là không hập gì vào ô A.., chỉ kích hoạt. Em mạn phép thêm dòng code này vào:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("A1:A10"), Target) Is Nothing Then
Rw = ActiveCell.Row - 1
If ActiveCell.Value = "" Then Exit Sub
If Cells(Rw, 1).Value >= 8 Then
Cells(Rw, 2).Value = "Häc lùc giâi"
ElseIf Cells(Rw, 1).Value >= 6.5 Then
Cells(Rw, 2).Value = "Häc lùc kh¸"
ElseIf Cells(Rw, 1).Value >= 5 Then
Cells(Rw, 2).Value = "Häc lùc trung b×nh"
Else
Cells(Rw, 2).Value = "Häc lùc kÐm"
End If
End If
End Sub

 

[dnphuonganh]

Hàm thì dễ rồi... nhưng ở đây là các bạn đang thực tập VBA theo bài giãng của thầy Phan Tự Hướng mà bạn... Có lẽ là đang tập tành nên biến thành Function e rằng vượt quá tầm tay của các bạn ấy... Vã lại nếu là Function thôi thì dùng hàm Excel cho xong (ít nhất là với bài toán này)
Đễ ý code này chỉ chạy khi Enter xuống dòng (dùng phím mũi tên di chuyển sang phải cũng ko chạy)... Xóa cột A gây lỗi tôi nghĩ sửa dễ hơn vụ xác định Row cũng cell vừa nhập liệu... Vậy phải làm sao đây? Tigertiger giúp xem

Anh anhtuan1066 hiểu ý người mới quá chừng!

 

[anhtuan1066]

He... he... Vậy là bạn đã nắm dc vấn đề rồi còn gì... Lỗi này tôi có thấy nhưng cứ đễ đấy cho bạn tự tìm hiểu...
Nhưng còn vụ Rw =ActiveCell.Row - 1 mới khó... Vụ này tôi chưa nghĩ ra dc... Đành trông chờ các cao thủ khác nhiều kinh nghiệm hơn vậy (tôi cũng mới tập tành thôi bạn à)
ANH TUẤN

 

[tigertiger]

oK, nhưng nếu MỚI thế thì ko nên vội dùng WorkSheet_change vội -> vì như thế thay đổi liên tục -> rối khi lập --> tốt nhất là chạy sub thì hay hơn


Đã chót làm cứ up lên tham khảo (không ích cho ng mới - thì ích cho người biết sơ sơ vậy)

Có thể dùng Font Abc hay VNI đều được chỉ cần lưu ý font nào thì tương ứng ở ô tính chọn font đó

Public Function XepLoaiAbc(Diem As Double)
    Dim kQ As String
    If Diem >= 8 Then
       kQ = "Häc lùc giâi"
       ElseIf Diem >= 6.5 Then
       kQ = "Häc lùc kh¸"
       ElseIf Diem >= 5 Then
       kQ = "Häc lùc trung b×nh"
       Else
       kQ = "Häc lùc kÐm"
    End If
    XepLoaiAbc = kQ
End Function

Và có thể dụng Font Unicode (xem chi tiết về sử dụng unicode tại đây http://www.giaiphapexcel.com/forum/showthread.php?t=2370

Public Function XepLoaiUni(Diem As Double)
    Dim kQ As String
    If Diem >= 8 Then
       kQ = "H" & ChrW(7885) & "c l" & ChrW(7921) & "c gi" & ChrW(7887) & "i"
       ElseIf Diem >= 6.5 Then
       kQ = "H" & ChrW(7885) & "c l" & ChrW(7921) & "c khá"
       ElseIf Diem >= 5 Then
       kQ = "H" & ChrW(7885) & "c l" & ChrW(7921) & "c trung bình"
       Else
       kQ = "H" & ChrW(7885) & "c l" & ChrW(7921) & "c kém"
    End If
    XepLoaiUni = kQ
End Function

để thực hiện hàm trên bấm Alt+F11 ->chọn Insert module -> copy và dán các code trên vào
_> khi đó có các hàm trên ->sd như hàm của Excel (bấm vào fx rồi chọn trong User define -> liệt kê hàm do NSD định nghĩa

 

[tigertiger]

Sao không phải là

 Rw=ActiveCell.Row

Vì ActiveCell.Row-1 sẽ thành hàng trên mà ; ko rõ ý atuan... thế nào?

 

[anhtuan1066]

Thì bạn cứ thử đi sẽ thấy điều kỳ lạ... Vì khi mình Enter xuống hàng thì ActiveCell đã trở thành dòng dưới rồi... Tôi ko khắc phục dc lỗi này nên đành làm tạm vậy! Bạn có ý kiến gì ko? Chứ ghi Rw=ActiveCell.Row thì phải thêm code gì đó nữa mới dc

 

[tigertiger]

Oh đúng rùi,

Vậy thì sửa thế này atuan ah

Để ý rằng:

+ Khi bấm phím ENTER thì chứng tỏ hàng (row) xuống 1 dòng-> Rw =ActiveCell.Row()-1 , lúc này cột (column) thay đổi sang cột B (=1)

+ Khi bấm nút MŨI TÊN PHẢI thì chứng tỏ hàng (row) không đổi-> sao cho Rw =ActiveCell.Row()+0 , lúc này cột (column) thay đổi sangg cột B (=2)


-> có thể có 2 cách xử lý sau:
- cách 1 (theo suy nghĩ thông thường)

If ActiveCell.Column =1 then 
    Rw =ActiveCell.Row()-1
Else
    Rw =ActiveCell.Row()
EndIf

-Nhưng cách hay hơn là cách 2 sau (dùng phương pháp cộng trừ)

 Rw = ActiveCell.Row + ActiveCell.Column - 2

Và kQ toàn bộ như sau

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Rw As Integer
  If Not Intersect(Range("A1:A10"), Target) Is Nothing Then
    Rw = ActiveCell.Row + ActiveCell.Column - 2
    If Cells(Rw, 1).Value = "" Then Exit Sub  
    
    If Cells(Rw, 1).Value >= 8 Then
        Cells(Rw, 2).Value = "Häc lùc giâi"
    ElseIf Cells(Rw, 1).Value >= 6.5 Then
        Cells(Rw, 2).Value = "Häc lùc kh¸"
    ElseIf Cells(Rw, 1).Value >= 5 Then
        Cells(Rw, 2).Value = "Häc lùc trung b×nh"
    Else
        Cells(Rw, 2).Value = "Häc lùc kÐm"
    End If
  End If
End Sub

 

[anhtuan1066]

Ai chà chà... Sao mình ngu thế nhỉ?
Ko thể ghi là ActiveCell.Row dc...
Sửa lại thành Rw = Target.Row là xong... (ko cần cộng, ko cần trừ gì ráo)
Tigertiger xem lại 1 chút ngay chổ này:
1> Cell ="" thì ko làm gì cả là đúng rồi.. nhưng giã sử như cell đang có dử liệu, ví dụ A5= 8, vậy B5 sẽ là Giõi... Khi ấy mình xóa A5 đi thì điều gì xảy ra? Lý ra B5 cũng sẽ rổng luôn mới hợp lý... Còn nữa.. giã sử người ta xóa toàn bộ từ A1:A10 thì sao? Theo lý B1:B10 cũng phải rỗng
2> Code của Tigertiger vẫn còn 2 lỗi: Thứ nhất xóa toàn bộ cột A bị lỗi... Thứ 2 nếu nhập liệu xong người ta ko Enter mà dùng chuột dời con trở đi nơi khác cũng toi (ví dụ dùng chuột chọn cell E5)
Tôi có code này... Tigertiger xem thử và sửa lại với:

Private Sub WorkSheet_Change(ByVal Target As Range)
     If Not Intersect(Range("A1:A10"), Target) Is Nothing Then
         On Error Resume Next
         Rw = Target.Row
         If Target.Value = "" Then
            Exit Sub
         End If
         Select Case Target.Value
                Case Is >= 8
                Cells(Rw, 2).Value = "G"
                Case Is >= 6
                Cells(Rw, 2).Value = "K"
                Case Is >= 5
                Cells(Rw, 2).Value = "TB"
                Case Is >= 0
                Cells(Rw, 2).Value = "Kem"
         End Select
     End If
End Sub

Code này sửa dc 1 vài lỗi... nhưng vẫn còn tồn tại là xóa cell tại A, bên cột B ko bị rỗng.. Bạn xem giúp với
ANH TUẤN

 

[anhtuan1066]

Chào bạn dnphuonganh!
Yêu cầu của bạn tưởng dễ, vậy mà làm mãi vẫn thấy có chổ ko ổn... Tôi nghĩ chắc chỉ có dùng FOR là ăn chắc mặc bền... Bạn thử code này:

Private Sub WorkSheet_Change(ByVal Target As Range)
     If Not Intersect(Range("A1:A10"), Target) Is Nothing Then
         For i = 1 To 10
             If Cells(i, 1).Value = "" Then
                    Cells(i, 2).Value = ""
             ElseIf Cells(i, 1).Value >= 8 Then
                    Cells(i, 2).Value = "G"
             ElseIf Cells(i, 1).Value >= 6 Then
                    Cells(i, 2).Value = "K"
             ElseIf Cells(i, 1).Value >= 5 Then
                    Cells(i, 2).Value = "TB"
             ElseIf Cells(i, 1).Value >= 0 Then
                    Cells(i, 2).Value = "Kem"
             End If
         Next i
     End If
End Sub

Code này gần như đúng đến 99%... Tức là bạn xóa cell bên cột A, dù là 1 cell hay toàn bộ thì cell tương ứng bên cột B sẽ rỗng theo... Nó chỉ còn 1 tí xíu trục trặc.. Bạn tự tìm hiểu xem trục trặc ấy là gì nhé
ANH TUẤN

 

[tigertiger]

Đơn giản đi

Yêu cầu của bạn tưởng dễ, vậy mà làm mãi vẫn thấy có chổ ko ổn... Tôi nghĩ chắc chỉ có dùng FOR là ăn chắc mặc bền... Bạn thử code này:

Oh atuan - nhiệt tình wa,

Các bạn đó đang học VBA mà chỉ thử sub thui mà

còn cách khác Đơn giản thôi đó là khi đó chỉ cần đơn giản thôi đó là thêm Cells(Rw, 2).Value="" vào đoạn:

         If Target.Value = "" Then
             Cells(Rw, 2).Value=""
             Exit Sub
         End If

và
nên có khai báo Dim Rw As Integer - vì mới học thì nên có khai báo đầy đủ cho nó bài bản.

Trở thành:

Private Sub WorkSheet_Change(ByVal Target As Range)
Dim Rw As Integer
     If Not Intersect(Range("A1:A10"), Target) Is Nothing Then
         On Error Resume Next
         Rw = Target.Row
         If Target.Value = "" Then
             Cells(Rw, 2).Value=""
             Exit Sub
         End If
         Select Case Target.Value
                Case Is >= 8
                Cells(Rw, 2).Value = "G"
                Case Is >= 6
                Cells(Rw, 2).Value = "K"
                Case Is >= 5
                Cells(Rw, 2).Value = "TB"
                Case Is >= 0
                Cells(Rw, 2).Value = "Kem"
         End Select
     End If
End Sub