Mã hóa giúp tên sách

HungQuoc49

Thành viên tiêu biểu
Tham gia ngày
9 Tháng bảy 2014
Bài viết
683
Được thích
439
Điểm
435
Em thử code của bác rồi, thấy cũng hay lắm đúng là đã giải quyết được ~ 90% rồi. Bác sửa giúp em chữ "Q" --> "QU" được không ạ?
Nếu có thể bác giúp em những từ đặc biệt này: gim, gin , ginh, gip, git lấy kí hiệu từ GI301 đến GI314.
Cảm ơn bác nhiều!
Bạn cần có 02 bảng:
1. Phụ âm--->Mã
2. Vần --->Mã

Bảng 2 đã có, bảng 1 bạn thiết kế nhé.
 

hoainam1301

Thành viên mới
Tham gia ngày
27 Tháng một 2011
Bài viết
10
Được thích
1
Điểm
365
Gửi lại bác file excel bác giúp đỡ nhé!
 

HungQuoc49

Thành viên tiêu biểu
Tham gia ngày
9 Tháng bảy 2014
Bài viết
683
Được thích
439
Điểm
435
Em thử code của bác rồi, thấy cũng hay lắm đúng là đã giải quyết được ~ 90% rồi. Bác sửa giúp em chữ "Q" --> "QU" được không ạ?
Nếu có thể bác giúp em những từ đặc biệt này: gim, gin , ginh, gip, git lấy kí hiệu từ GI301 đến GI314.
Gim = GI + im --> GI301
An = A + an --> A105 Ân = Â + ân --> 121
Uyên = U + uyên --> U527 Yên = Y + yên --> Y603, v.v...
Cảm ơn bác nhiều!
Kiểm tra file đính kèm xem sao.
Sách tiếng anh chắc không ổn

Mã:
Public Sub Ma_Hoa_Ten_Sach()
Dim DL, MaVan, XoaDau, PhuAm, Tam, kq(), r As Long, rw As Long,c As Long, i

DL = Sheet2.Range("A2", Sheet2.Range("A65000").End(xlUp))
MaVan = Sheet1.Range("A1").CurrentRegion
XoaDau = Sheet1.Range("D1").CurrentRegion
PhuAm = Sheet1.Range("G1").CurrentRegion
ReDim kq(1 To UBound(DL), 5)

'Xoa dau, tach tu
For r = 1 To UBound(DL)
Tam = Split(LCase(DL(r, 1)) & " ", " ")
DL(r, 1) = Tam(0) & " " & Tam(1)

For c = 1 To Len(DL(r, 1))
For rw = 1 To UBound(XoaDau)
If Mid(DL(r, 1), c, 1) = XoaDau(rw, 1) Then
Mid(DL(r, 1), c, 1) = XoaDau(rw, 2)
End If
Next rw
Next c
Tam = Split(DL(r, 1), " ")

kq(r, 4) = Tam(0): kq(r, 5) = Tam(1)
Next r

'Tach PhuAm va Van. Nap ma so
With CreateObject("VBScript.RegExp")
For r = 1 To UBound(kq)

'Tách từ thứ 1
i = 0
For rw = 1 To UBound(PhuAm)
.Pattern = "^" & PhuAm(rw, 1)
If .test(kq(r, 4)) Then
If i < Len(.Execute(kq(r, 4))(0)) Then
i = Len(.Execute(kq(r, 4))(0))
End If
End If
Next rw

If i = 0 Then
kq(r, 1) = Left(kq(r, 4), 1): kq(r, 2) = kq(r, 4)
Else
kq(r, 1) = Left(kq(r, 4), i)
kq(r, 2) = Right(kq(r, 4), Len(kq(r, 4)) - i)
End If

'Tách từ thứ 2
i = 0
For rw = 1 To UBound(PhuAm)
.Pattern = "^" & PhuAm(rw, 1)
If .test(kq(r, 5)) Then
If i < Len(.Execute(kq(r, 5))(0)) Then
i = Len(.Execute(kq(r, 5))(0))
End If
End If
Next rw

If i = 0 Then
kq(r, 3) = Left(kq(r, 5), 1)
Else
kq(r, 3) = Left(kq(r, 5), i)
End If

'Nạp mã số vần
For rw = 1 To UBound(MaVan)
If kq(r, 2) = MaVan(rw, 1) Then kq(r, 2) = MaVan(rw, 2): Exit For
Next rw

'Kiểm tra lại mã số vần
'nếu không phải là số thì ghép thêm từ của phụ âm trước và nạp lại ( Chữ gi )
If IsNumeric(kq(r, 2)) = False Then
For rw = 1 To UBound(MaVan)
If Right(kq(r, 1), 1) & kq(r, 2) = MaVan(rw, 1) Then kq(r, 2) = MaVan(rw, 2): Exit For
Next rw
End If

kq(r, 0) = UCase(kq(r, 1) & kq(r, 2) & kq(r, 3))
Next r
End With

Sheet2.Range("B2").End(xlDown).ClearContents
Sheet2.Range("B2").Resize(UBound(DL), 1).Value = kq
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:

hoainam1301

Thành viên mới
Tham gia ngày
27 Tháng một 2011
Bài viết
10
Được thích
1
Điểm
365
Kiểm tra file đính kèm xem sao.
Sách tiếng anh chắc không ổn
Đúng là cái em cần. Hiện tại em chưa làm sách tiếng anh nhưng kiểm tra thấy code ổn lắm chưa thấy lỗi gì cả.

Cảm ơn bác nhiều nhiều!
Chúc bác vui vẻ mạnh khỏe để giúp đỡ được nhiều người hơn!
 

Trần vân ks

Thành viên mới
Tham gia ngày
2 Tháng ba 2019
Bài viết
1
Được thích
0
Điểm
13
Tuổi
32
Chả là em muốn mã hóa tên sách như sau:
Lấy chữ cái đầu tên trong hai chữ đầu của sách. Ví dụ Thảo nguyên xanh thì chọn là Thảo nguyên. Chọn con chữ TH của chữ thứ nhất. Sau đó lấy vần của chữ đầu tiên là ao để so sánh với bảng mã giả sử là 108chẳng hạn. Ghép với con chữ NG của chữ thứ 2.

Thì tên sách được mã hóa là: TH108NG
Bạn ơi đây là bảng mã hoá à bạn, mình mới đc giao mảng thư viện, mà mình lại ko có nghiệp vụ, hix. Nhìn mọi ng nói mình thấy nản quá
 
Top Bottom