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

Liên hệ QC

hoainam1301

Thành viên mới
Tham gia
27/1/11
Bài viết
10
Được thích
1
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
 

File đính kèm

  • MA HOA TEN SACH.xls
    33 KB · Đọc: 256
Lần chỉnh sửa cuối:
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é.
 
Upvote 0
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

  • MA HOA TEN SACH.xls
    55.5 KB · Đọc: 89
Lần chỉnh sửa cuối:
Upvote 1
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!
 
Upvote 0
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á
 
Upvote 0
Web KT
Back
Top Bottom