Chuyên mục xử lý, gỡ rối code VBA (1 người xem)

ndu96081631 · 24/9/13

Topic Những câu hỏi về code, xin giải thích các code... đã quá dài nên mình đóng nó lại và mở topic khác
Tất cả những bài viết liên quan đến việc nhờ giải thích, xử lý và gỡ rối code VBA, các bạn vui lòng đăng tại đây!
Cảm ơn

nmthanh2011 · 19/1/18

be09 đã viết:
Nội dung theo dõi về tố cáo, khiếu nại trước đây (khoảng 7 năm) tôi viết hẳn 1 File theo dõi cho cơ quan, nhưng rất tiếc cơ quan không dùng (lý do đã có phần mềm theo dõi), để tôi tìm lại và sửa cho phù hợp cái bạn cần. Vậy, bạn hãy chờ tôi tìm (giờ không nhớ để nó ở cái xó nào).

Cảm ơn bạn.

be_09 · 19/1/18

nmthanh2011 đã viết:
Cảm ơn bạn.

Tôi chưa rảnh để tìm File, bạn vào tải File ở bài 130 của Link sau xem có dùng được không? Tôi nghĩ thêm bớt 1 chút là dùng được.

http://www.giaiphapexcel.com/diendan/threads/quản-lý-công-văn-đi-và-đến.10068/page-7

ndu96081631 · 19/1/18

Nguyễn Hoàng Oanh Thơ đã viết:
Cảm ơn ndu96081631 đã giúp đỡ.
Nhờ bạn xử lý giúp tôi cho trường hợp này ạ.

Vẫn quan điểm ở trên: Tuyệt đối không nên gán công thức vào Target khi thực hiện sự kiện Change (dễ bị lỗi) mà nên tính toán trực tiếp trong code
Ví dụ:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rngFind As Range, cel As Range
  Dim lOffset1 As Long, lOffset2 As Long, lOffset3 As Long
  Application.EnableEvents = False
  On Error Resume Next
  If Target.Row >= 9 And Target.Row <= 16 Then
    If Target.Column = 4 Then lOffset1 = 1
    If Target.Column = 6 Then lOffset1 = -1
    If lOffset1 Then
      lOffset2 = (1 - lOffset1) / 2
      lOffset3 = lOffset1 * 2
      For Each cel In Target
        If cel.Column = 4 Or cel.Column = 6 Then
          Set rngFind = Range("DANHSACH").Resize(, 1).Offset(, lOffset2).Find(cel.Value, , xlValues, xlWhole)
          If Not rngFind Is Nothing Then
            cel.Offset(, lOffset3).Value = rngFind.Offset(, lOffset1).Value
          Else
            cel.Offset(, lOffset3).ClearContents
          End If
        End If
      Next
    End If
  End If
  If Err.Number Then MsgBox Err.Description
  Application.EnableEvents = True
End Sub

Trong đó:
- DANHSACH chính là Define name của vùng J9:K16 (bạn tự đặt)
- lOffset1, lOffset2 và lOffset3 là các con số dùng để dịch chuyển cột sang trái hoặc phải (tự tính cho phù hợp)
----------------------------------
Ngoài ra có 1 lưu ý quan trọng: Khi sự kiện Change thực hiện sự thay đổi ngay trên Target thì bắt buộc phải có cặp lệnh: Application.EnableEvents = False ở đầu code và Application.EnableEvents = True ở cuối code, nếu không sẽ có lúc rơi vào "vòng lập vô tân". Có nghĩa là:
- Khi ta thay đổi trên sheet thì code sự kiện sẽ chạy
- Code chạy làm thay đổi giá trị trên sheet
- Sự thay đổi giá trị trên sheet mà giá trị này nằm ngay vùng Target sẽ làm code chạy tiếp
.... cứ thế mãi không ngừng đến lúc treo máy mới thôi
----------------------------------
Code ở trên dài thế vì:
- Nó còn làm được việc cho phép copy paste nhiều cell cùng lúc
- Khi xóa cột này thì cột kia sẽ bị xóa theo
- vân vân...

Hoàng Nhật Phương · 19/1/18

ndu96081631 đã viết:
Vẫn quan điểm ở trên: Tuyệt đối không nên gán công thức vào Target khi thực hiện sự kiện Change (dễ bị lỗi) mà nên tính toán trực tiếp trong code
Ví dụ:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range) Dim rngFind As Range, cel As Range Dim lOffset1 As Long, lOffset2 As Long, lOffset3 As Long Application.EnableEvents = False On Error Resume Next If Target.Row >= 9 And Target.Row <= 16 Then If Target.Column = 4 Then lOffset1 = 1 If Target.Column = 6 Then lOffset1 = -1 If lOffset1 Then lOffset2 = (1 - lOffset1) / 2 lOffset3 = lOffset1 * 2 For Each cel In Target If cel.Column = 4 Or cel.Column = 6 Then Set rngFind = Range("DANHSACH").Resize(, 1).Offset(, lOffset2).Find(cel.Value, , xlValues, xlWhole) If Not rngFind Is Nothing Then cel.Offset(, lOffset3).Value = rngFind.Offset(, lOffset1).Value Else cel.Offset(, lOffset3).ClearContents End If End If Next End If End If If Err.Number Then MsgBox Err.Description Application.EnableEvents = True End Sub

Trong đó:
- DANHSACH chính là Define name của vùng J9:K16 (bạn tự đặt)
- lOffset1, lOffset2 và lOffset3 là các con số dùng để dịch chuyển cột sang trái hoặc phải (tự tính cho phù hợp)
----------------------------------
Ngoài ra có 1 lưu ý quan trọng: Khi sự kiện Change thực hiện sự thay đổi ngay trên Target thì bắt buộc phải có cặp lệnh: Application.EnableEvents = False ở đầu code và Application.EnableEvents = True ở cuối code, nếu không sẽ có lúc rơi vào "vòng lập vô tân". Có nghĩa là:
- Khi ta thay đổi trên sheet thì code sự kiện sẽ chạy
- Code chạy làm thay đổi giá trị trên sheet
- Sự thay đổi giá trị trên sheet mà giá trị này nằm ngay vùng Target sẽ làm code chạy tiếp
.... cứ thế mãi không ngừng đến lúc treo máy mới thôi
----------------------------------
Code ở trên dài thế vì:
- Nó còn làm được việc cho phép copy paste nhiều cell cùng lúc
- Khi xóa cột này thì cột kia sẽ bị xóa theo
- vân vân...

Cảm ndu96081631 nhiều nhé,
ở bài trước Oanh Thơ định thắc mắc về Application.EnableEvents = False chưa kịp hỏi thì đã được bạn giải thích rõ ràng và giúp đỡ phương pháp tối hơn.
Khi áp dụng nếu có vấn đề gì rất mong lại được hỗ trợ ạ.

teaklee · 20/1/18

Mọi người gỡ rối giúp code này với. Mình viết code VBA chèn công thức vào vùng từ G3:G66 với dữ liệu được chọn từ F3:F66
Nhưng khi chạy code nó copy công thức cho hết nguyên cột G. Giờ muốn nó chạy tới G66 thôi thì sao vậy các bác

Mã:

    With ShTrangChu.Range("g3:g66" & [f66].End(3).Row)
        .Value = "=IF(RC[-1]=0,0,HLOOKUP(R2C2,Data!R2C3:R180C250,MATCH(RC[-1],Data!R2C2:R198C2,0),0))"
        .Value = "'" & .Value
    End With

Đừng Lắm Mồm · 20/1/18

teaklee đã viết:
Mọi người gỡ rối giúp code này với. Mình viết code VBA chèn công thức vào vùng từ G3:G66 với dữ liệu được chọn từ F3:F66
Nhưng khi chạy code nó copy công thức cho hết nguyên cột G. Giờ muốn nó chạy tới G66 thôi thì sao vậy các bác

Mã:

With ShTrangChu.Range("g3:g66" & [f66].End(3).Row) .Value = "=IF(RC[-1]=0,0,HLOOKUP(R2C2,Data!R2C3:R180C250,MATCH(RC[-1],Data!R2C2:R198C2,0),0))" .Value = "'" & .Value End With

Xem lại cái này là cái gì

Mã:

 With ShTrangChu.Range("g3:g66" & [f66].End(3).Row)

thành

Mã:

 With ShTrangChu.Range("g3:g"& [f65000].End(3).Row)

teaklee · 20/1/18

Đừng Lắm Mồm đã viết:
Xem lại cái này là cái gì

Mã:

With ShTrangChu.Range("g3:g66" & [f66].End(3).Row)

thành

Mã:

With ShTrangChu.Range("g3:g"& [f65000].End(3).Row)

Ban đầu code là như bạn sửa á, mình muốn chèn hàm JointText vào cell G67 để nó joint các text nằm ở các ô khác, nhưng khi chạy thì nó copy công thức xuống toàn bộ các cell trong cột G. Nên mình sửa lại thành như code mình đăng lên.
Hàm Jointext viết trong VBA sẽ báo lỗi khi viết công thức có chứa ký tự đặt biệt:
Mình viết

Mã:

With ShTrangChu.range (G67)
          .value = "Jointext (",", G8, G13:G23)"
          .value = .value
End with

Nhưng không đưa ra cell được do VBA báo lỗi chỗ ","
Nên mình chèn ngoài worksheet. Nhưng bị cái code trên chèn công thức vô nguyên cột.

ndu96081631 · 20/1/18

teaklee đã viết:
Hàm Jointext viết trong VBA sẽ báo lỗi khi viết công thức có chứa ký tự đặt biệt:
Mình viết

Mã:

With ShTrangChu.range (G67) .value = "Jointext (",", G8, G13:G23)" .value = .value End with

Nhưng không đưa ra cell được do VBA báo lỗi chỗ ","
Nên mình chèn ngoài worksheet. Nhưng bị cái code trên chèn công thức vô nguyên cột.

Chỗ nào là text được đặt trong cặp nháy đôi thì khi đưa vào VBA phải sửa 1 dấu nháy đôi thành 2 dấu

Mã:

.value = "=Jointext("","",G8,G13:G23)"

teaklee · 20/1/18

ndu96081631 đã viết:
Chỗ nào là text được đặt trong cặp nháy đôi thì khi đưa vào VBA phải sửa 1 dấu nháy đôi thành 2 dấu

Mã:

.value = "=Jointext("","",G8,G13:G23)"

Thank bác hàm chạy rồi ạ

thinh33542 · 23/1/18

Em chào cả nhà
Em đang code VBA để tự động hóa công việc ghép hàng vào xe (điều phối vận chuyển)
Đề bài:
- Có tổng 500 điểm phải giao hàng, khối lượng mỗi điểm giao dao động từ 0,01 tấn đến 5 tấn, tổng khối lượng phải giao là 75 tấn
+ Thứ tự địa chỉ giao đã được sắp xếp từ trên xuống dưới -> không quan tâm đến khoảng cách
+ Tồn tại 1 số điểm có lối vào nhỏ hẹp, chỉ có thể đi xe có tải trọng nhỏ nhất (0,6 tấn)
- Có 15 xe 6 tạ và 10 xe 1 tấn , tổng trọng tải là 19 tấn
+Các xe chạy chuyến 1 thì Xếp từ 1 đến 7 điểm giao hàng
+Các xe chuyến 2,3 xếp từ 5 đến 25 điểm giao hàng
Yêu cầu: Xếp mỗi xe 3 chuyến sao cho khối lượng vận chuyển/1 chuyến phải >70% trọng tải xe và ≤ 100% trọng tải xe (ưu tiên chở tối đa tải trọng)
Cách làm tay trong thực tế:

Ưu tiên chuyến 1 chở hết các điểm giao có khối lượng vận chuyển lớn hơn tải trọng max của xe (phải dùng từ 2 xe trở lên mới giao hết hàng)
Ghép thêm hàng cho các xe thiếu tải (ví dụ tồn tại 1 điểm giao 1,3 tấn; đã dùng 1 xe 1 tấn và 1 xe 0,6 tấn -> Xe 0,3 tấn chưa đủ tải)
Dùng xe nhỏ 0,6 tấn ghép hết các điểm có lối vào nhỏ hẹp, chỉ có thể đi xe có tải trọng nhỏ nhất (1 xe đi giao nhiều điểm)
Ghép từ trên xuống dưới vào các xe còn lại sao cho đúng quy định tải trọng (lơn hơn 70% và nhỏ hơn bằng 100%) (1 xe đi giao nhiều điểm)

Ghép cho đến khi hoặc là hàng hết hoặc là xe hết
*Hiện em đang dùng If, vòng lặp while,..và 1 số hàm cơ bản để mô tả lại các công việc thành code, nhưng do việc dùng vòng lặp nhiều quá + số line nhiều dẫn tới excel không thể xử lý được
Ví dụ:
While WorksheetFunction.Max(Range("J3:J" & DongCuoi5)) > WorksheetFunction.Max(Sheets("DieuXe").Range("C29:C49"))
a = WorksheetFunction.Max(Range("J3:J" & DongCuoi5))
b = WorksheetFunction.Match(a, Range("J3:J" & DongCuoi5, 0))
c = WorksheetFunction.Max(Sheets("DieuXe").Range("C29:C49"))
d = WorksheetFunction.Match(c, Sheets("DieuXe").Range("C29:C49"), 0)
While Cells(b + 2, 10) > WorksheetFunction.Max(Sheets("DieuXe").Range("C29:C49"))
Cells(b + 2, 10) = a - WorksheetFunction.Max(Sheets("DieuXe").Range("C29:C49"))
d = WorksheetFunction.Match(c, Sheets("DieuXe").Range("C29:C49"), 0)
e = 1
Cells(b + 2, 11 + e) = Sheets("DieuXe").Cells(28 + d, 2)
Sheets("DieuXe").Cells(28 + d, 3) = 0
Sheets("DieuXe").Cells(28 + d, 3 + e) = Cells(b + 2, 5)
e = e + 1
Wend
c = WorksheetFunction.Max(Sheets("DieuXe").Range("C29:C49"))
d = WorksheetFunction.Match(c, Sheets("DieuXe").Range("C29:C49"), 0)
Sheets("DieuXe").Cells(28 + d, 3) = c - Cells(b + 2, 10)
Cells(b + 2, 10) = 0
Cells(b + 2, 11 + e) = Sheets("DieuXe").Cells(28 + d, 2)
Sheets("DieuXe").Cells(28 + d, 4) = Cells(b + 2, 5)
While Sheets("DieuXe").Cells(28 + d, 3) > 0.05
Wend
Wend

* Mong các anh chị góp ý định hướng giúp em, với đề bài toán thực tế như trên, thì em nên code theo hướng nào ạ? Dùng ngôn ngữ gì để có thể xử lý nhanh? cần dùng những kiến thức gì để có thể làm được....
Em cảm ơn mọi người nhiều ạ

thinh33542 · 24/1/18

Mong cả nhà định hướng góp ý giúp em với ạ
Định hướng giúp em nên dùng kiến thức gì để có thể làm được ạ, ngôn ngữ lập trình......gì cũng được ạ, em không sợ khó, chỉ sợ không tìm ra hướng giải quyết

Trong 4 bước thực tế làm thì em mới code được bước 1 nhưng mà không biết kết quả ra sao vì excel cứ quay quay không thấy ra kết quả
Bước 2,3,4 em mới ra ý tưởng, dùng kỹ thuật quay lui, nhưng mà lặp bước 1 đã treo excel rồi thì không thể làm các bước tiếp theo được
Hiện em cũng đang nghĩ cách cải tiến code và ý tưởng để có thể làm được, mấy khoản ghép hàng vào xe chỉ cộng thủ công cơ bản, nên máy tính hoàn toàn có thể bắt chước để ghép hàng tự động được, mấy hôm trước em có đọc 1 bài trên giaiphapexcel: Đề bài cho 1 dãy số, yêu cầu tìm những số thỏa mãn tổng của chúng gần nhất với tổng A cho trước, bài của em cũng chỉ là verson 2 của bài đó thôi (tìm các điểm giao hàng có tổng KLVC gần với trọng tải xe nhất)
Em xin phép gửi file excel ví dụ

trongkhanh95 · 26/1/18

Em có đoạn code để short 2 cột A,B ở sheet 1. Khi em qua sheet 2 và muôn sử dụng đoạn cốt này ở sheet 2 nhưng làm thế nào để ActiveWorkbook.Worksheets("Sheet1") chuyển thành ActiveWorkbook.Worksheets("Sheet2") được ạ? em cảm ơn!

Sub short()
'
' short Macro
'

'
Columns("A:B").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B1:B100") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:B100")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

ndu96081631 · 26/1/18

trongkhanh95 đã viết:
Em có đoạn code để short 2 cột A,B ở sheet 1. Khi em qua sheet 2 và muôn sử dụng đoạn cốt này ở sheet 2 nhưng làm thế nào để ActiveWorkbook.Worksheets("Sheet1") chuyển thành ActiveWorkbook.Worksheets("Sheet2") được ạ? em cảm ơn!

Sub short()
'
' short Macro
'

'
Columns("A:B").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B1:B100") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:B100")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

Khỏi cần ghi tên sheet hay tên workbook thì Excel sẽ hiểu đó là ActiveSheet và ActiveWorkbook
Ví dụ:

Mã:

Sub Test()
  With Range("A1:B1000")
    .Sort .Cells(1, 2), xlDescending, .Cells(1, 1), , xlDescending, , , xlNo
  End With
End Sub

Sort cột A giảm dần theo cột B tăng dần

trongkhanh95 · 26/1/18

ndu96081631 đã viết:
Khỏi cần ghi tên sheet hay tên workbook thì Excel sẽ hiểu đó là ActiveSheet và ActiveWorkbook
Ví dụ:

Mã:

Sub Test() With Range("A1:B1000") .Sort .Cells(1, 2), xlDescending, .Cells(1, 1), , xlDescending, , , xlNo End With End Sub

Sort cột A giảm dần theo cột B tăng dần

CẢM ƠN ANH.

bigbabol89 · 26/1/18

Em có sưu tầm được 1 code copy dữ liệu từ những ô bình thường sang những ô filter. Tuy nhiên em mắc phải vấn đề là :
1. Khi vùng copy cũng là vùng filter thì paste sang vùng filter kia bị lỗi.
2. Khi paste thì giá trị ở ô cuối cùng lặp lại = số hàng đã chọn. VD : em copy dữ liệu ở ô A1,A2,A3 có giá trị lần lượt là "vịt","gà"," mèo" thì khi paste nó sẽ hiện ra là vịt , gà , mèo, mèo , mèo , mèo ( tức là thêm 3 lần "mèo" nữa ).
3. Không áp dụng được copy từ file excel này qua file excel khác được, chỉ làm được nếu trong cùng 1 file ( có thể khác sheet ).
Rất mong các anh giúp đỡ em.
Sub Paste_to_Visible_Rows()

Dim Nguon As Range, Dich As Range
Dim i As Long, r As Long
Set Nguon = Application.InputBox(prompt:="Chon Vung Copy ", Type:=8)
Set Dich = Application.InputBox(prompt:="Chep Den ", Type:=8)
For i = 1 To Nguon.Rows.Count
Do Until Not Dich.Offset(r).Rows.Hidden
r = r + 1
Loop
Nguon.Rows(i).Copy Destination:=Dich.Offset(r)
r = r + 1
Next i

End Sub

moctriet · 31/1/18

Em có chút vấn đề về lỗi out of memory khi em chạy chương trình khá nhiều code. Em đang cố gắng sửa lại code tối ưu hóa tuy nhiên chưa được tốt cho lắm. Do lần đầu viết một ứng dụng dài hơi nên xin vài "Gợi ý" của các anh chị để tối ưu hóa và giảm thiểu lỗi trên ạ. Em xin cảm ơn. (Do em viết cho công ty em nên không tiện share code).

VetMini · 31/1/18

Đầu tiên hết thì kiểm soát hàm đệ quy.

Ngoại trừ trường hợp hàm đệ quy ra, có 3 lý do chính để một chương trình bị phình ra và "out of memory". Đây là danh sách có sự sắp xếp, cần làm theo đúng thứ tự.

1/ dùng mảng quá lớn. Sửa bằng cách reset mảng lại sau khi dùng. Với VBA thì có thêm trường hợp string bị phình, cần set lại thành "".

2/ dùng quá nhiều objects lớn. Dùng xong thì Set chúng lại thành nothing.

3/ riêng đối với Excel, mở nhiều files có màu mè mẫu mã cũng bị tốn bộ nhớ.
3.1 đối với trường hợp nhiều code, tránh màu mè mẫu mã và shapes trong file và tránh ba cái mớ dialog box màu mè.
3.2 đóng bớt các files đã dùng xong
3.3 nếu code có dùng các objects chuyên về dữ liệu như ADO thì phải coi chừng connection và recordset.
3.4 nếu làm mọi thứ mà vẫn không được thì canh cứ khoảng vài giây, cho code save file lại. Khi được save, Excel sẽ nhả những phần memory mà nó chứa trong cache.

moctriet · 31/1/18

VetMini đã viết:
Đầu tiên hết thì kiểm soát hàm đệ quy.

Ngoại trừ trường hợp hàm đệ quy ra, có 3 lý do chính để một chương trình bị phình ra và "out of memory". Đây là danh sách có sự sắp xếp, cần làm theo đúng thứ tự.

1/ dùng mảng quá lớn. Sửa bằng cách reset mảng lại sau khi dùng. Với VBA thì có thêm trường hợp string bị phình, cần set lại thành "".

2/ dùng quá nhiều objects lớn. Dùng xong thì Set chúng lại thành nothing.

3/ riêng đối với Excel, mở nhiều files có màu mè mẫu mã cũng bị tốn bộ nhớ.
3.1 đối với trường hợp nhiều code, tránh màu mè mẫu mã và shapes trong file và tránh ba cái mớ dialog box màu mè.
3.2 đóng bớt các files đã dùng xong
3.3 nếu code có dùng các objects chuyên về dữ liệu như ADO thì phải coi chừng connection và recordset.
3.4 nếu làm mọi thứ mà vẫn không được thì canh cứ khoảng vài giây, cho code save file lại. Khi được save, Excel sẽ nhả những phần memory mà nó chứa trong cache.

Em cảm ơn anh đã chỉ bảo ạ. Em sẽ xem xét các hướng dẫn của anh ở trên để tinh chỉnh lại để code chạy được suôn sẻ hơn

quanglon1989 · 1/2/18

Em nhờ các bác trên này viết được 1 đoạn code để sửa tên sheet từ thông tin 1 ô trong sheet đó.
Đoạn mã code:
Private Sub Worksheet_Deactivate()
On Error GoTo ext
Me.Name = [b1]
ext:
End Sub

Em muốn thêm nhu cầu nữa là chuyển tên sheet từ có dấu thành không dấu.
Nhờ các bác giúp đỡ.
Em cảm ơn mọi người trước!

giaiphap · 1/2/18

quanglon1989 đã viết:
Em nhờ các bác trên này viết được 1 đoạn code để sửa tên sheet từ thông tin 1 ô trong sheet đó.
Đoạn mã code:
Private Sub Worksheet_Deactivate()
On Error GoTo ext
Me.Name = [b1]
ext:
End Sub

Em muốn thêm nhu cầu nữa là chuyển tên sheet từ có dấu thành không dấu.
Nhờ các bác giúp đỡ.
Em cảm ơn mọi người trước!

Bạn thêm code sau vào Module.

Mã:

Function ConvertToUnSign(ByVal sContent As String) As String
     Dim i As Long
     Dim intCode As Long
     Dim sChar As String
     Dim sConvert As String
     ConvertToUnSign = AscW(sContent)
     For i = 1 To Len(sContent)
        sChar = Mid(sContent, i, 1)
        If sChar <> "" Then
            intCode = AscW(sChar)
        End If
        Select Case intCode
            Case 273
                sConvert = sConvert & "d"
            Case 272
                sConvert = sConvert & "D"
            Case 224, 225, 226, 227, 259, 7841, 7843, 7845, 7847, 7849, 7851, 7853, 7855, 7857, 7859, 7861, 7863
                sConvert = sConvert & "a"
            Case 192, 193, 194, 195, 258, 7840, 7842, 7844, 7846, 7848, 7850, 7852, 7854, 7856, 7858, 7860, 7862
                sConvert = sConvert & "A"
            Case 232, 233, 234, 7865, 7867, 7869, 7871, 7873, 7875, 7877, 7879
                sConvert = sConvert & "e"
            Case 200, 201, 202, 7864, 7866, 7868, 7870, 7872, 7874, 7876, 7878
                sConvert = sConvert & "E"
            Case 236, 237, 297, 7881, 7883
                sConvert = sConvert & "i"
            Case 204, 205, 296, 7880, 7882
                sConvert = sConvert & "I"
            Case 242, 243, 244, 245, 417, 7885, 7887, 7889, 7891, 7893, 7895, 7897, 7899, 7901, 7903, 7905, 7907
                sConvert = sConvert & "o"
            Case 210, 211, 212, 213, 416, 7884, 7886, 7888, 7890, 7892, 7894, 7896, 7898, 7900, 7902, 7904, 7906
                sConvert = sConvert & "O"
            Case 249, 250, 361, 432, 7909, 7911, 7913, 7915, 7917, 7919, 7921
                sConvert = sConvert & "u"
            Case 217, 218, 360, 431, 7908, 7910, 7912, 7914, 7916, 7918, 7920
                sConvert = sConvert & "U"
            Case 253, 7923, 7925, 7927, 7929
                sConvert = sConvert & "y"
            Case 221, 7922, 7924, 7926, 7928
                sConvert = sConvert & "Y"
            Case Else
                sConvert = sConvert & sChar
        End Select
     Next
     ConvertToUnSign = sConvert
  End Function

Sau đó tiếp tục sửa code của bạn như sau:

Mã:

Private Sub Worksheet_Deactivate()
On Error GoTo ext
Me.Name = ConvertToUnSign([b1].Text)
ext:
End Sub

Chuyên mục xử lý, gỡ rối code VBA (1 người xem)

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

Huyền thoại GPE

Thành viên mới

Biên Hòa, Đồng Nai

Huyền thoại GPE

File đính kèm

Thành viên gắn bó

Thành viên mới

Thành viên mới

Thành viên mới

Huyền thoại GPE

Thành viên mới

Thành viên mới

Thành viên mới

File đính kèm

Thành viên mới

File đính kèm

Huyền thoại GPE

Thành viên mới

Thành viên thường trực

Thành viên thường trực

File đính kèm

Ăn cùng góc phố

Thành viên thường trực

Thành viên mới

==(^o^)==

Đếm ngược thời gian