Tách các thành phần của tiếng
- Thread starter nghiank09
- Ngày gửi
Maika8008
Thành viên gạo cội
- Tham gia
- 12/6/20
- Bài viết
- 4,741
- Được thích
- 5,669
- Donate (Momo)
- Giới tính
- Nam
Chữ dây mà thanh bằng là thấy sai sai rồi, lẽ ra là "dấu" KHÔNG. Chị HUYỀN NGÃ NẶNG anh ơi. HỎI anh SẮC thuốc chị thời bớt KHÔNG. Còn bằng, trắc là niêm luật trong thơ ca. Thanh bằng gồm dấu HUYỀN và dấu KHÔNG. Thanh trắc gồm các dấu còn lại.
Câu đối: Sắc hỏi Huyền ngã nặng không - O e cu ca hát ít (o e q k h x).
.
Nếu chỉ dùng để gieo vần làm thơ thì chỉ cần biết bằng trắc. Vần bằng chia làm phù bình thanh (không dấu) và trầm bình thanh (huyền).
Nếu phân tích "thanh" tiếng Việt (và tiếng Hán) thì thực ra có tất cả 4 thanh Bình Thượng Khứ Nhập, và 2 bậc Phù Trầm.
4 thanh hợp với 2 bậc cho ra tất cả 8 thanh. Tiếng Việt tuy chỉ có 6 dấu nhưng riêng dấu sắc và dấu nặng lại chia ra hai dòng, "Khứ" khi từ kết bình thường (vd tí, tín, tính) và "Nhập" khi từ kết bằng ch, p, t (vd. tích/tịch, tít/tịt, tiếp/tiệp).
Tôi không hiểu thớt muốn nói âm và thanh của mình là cái gì.
Lần chỉnh sửa cuối:
nghiank09
Thành viên hoạt động
- Tham gia
- 1/3/12
- Bài viết
- 143
- Được thích
- 30
Thành thật xin lỗi các bạn, mình đã nhầm lẫn về thanh và dấu. Cho mình đính chính lại là mình muốn tách thành âm đầu, vần và dấu. Dấu ở đây gồm: sắc, huyền, hỏi, ngã, nặng và KHÔNG DẤU ạ. Mình cần tách tiếng ra các thành phần để hỗ trợ làm thơ và nghiên cứu về cách nói lái trong tiếng việt. Xin cám ơn các bạn.
Lần chỉnh sửa cuối:
Dùng hàm tự tạo
Mã:
Dim KT$, Thanh$, aAmDau, aDau
Function TachVan(ByVal Text As String, ByVal iD As Long, ByVal Col As Long) As String
Dim tmp$, j&, i&, Res1
If Text = Empty Then Exit Function
If KT = Empty Then Call CreateKyTu
tmp = Split(Text, " ")(iD - 1)
For j = UBound(aAmDau) To 0 Step -1
If InStr(1, tmp, aAmDau(j), vbTextCompare) = 1 Then
Res1 = aAmDau(j)
If Col = 1 Then TachVan = Res1: Exit Function
Exit For
End If
Next j
If Res1 <> Empty Then tmp = Mid(tmp, Len(Res1) + 1, Len(tmp))
For j = 1 To Len(tmp)
i = InStr(1, Thanh, Mid(tmp, j, 1), vbTextCompare)
If i > 0 Then
If Col = 3 Then
TachVan = aDau(((i - 1) Mod 5)): Exit Function
ElseIf Col = 2 Then
Mid(tmp, j, 1) = Mid(KT, i, 1)
TachVan = tmp: Exit Function
End If
End If
Next j
If Col = 2 Then TachVan = tmp
End Function
Private Sub CreateKyTu()
Dim aKT, aThanh, j&
aDau = Array("s" & ChrW(7855) & "c", "huy" & ChrW(7873) & "n", "h" & ChrW(7887) & "i", "ngã", "n" & ChrW(7863) & "ng")
aAmDau = Array("b", "c", "ch", "d", ChrW(273), "g", "gh", "gi", "h", "k", "kh", "l", "m", "n", "ng", "ngh", "nh", "ph", "qu", "r", "s", "t", "th", "tr", "v", "x")
aKT = Array(97, 97, 97, 97, 97, 259, 259, 259, 259, 259, 226, 226, 226, 226, 226, 101, 101, 101, 101, 101, 234, 234, 234, 234, 234, 105, 105, 105, 105, 105, 111, 111, 111, 111, 111, 244, 244, 244, 244, 244, 417, 417, 417, 417, 417, 117, 117, 117, 117, 117, 432, 432, 432, 432, 432, 121, 121, 121, 121, 121)
aThanh = Array(225, 224, 7843, 227, 7841, 7855, 7857, 7859, 7861, 7863, 7845, 7847, 7849, 7851, 7853, 233, 232, 7867, 7869, 7865, 7871, 7873, 7875, 7877, 7879, 237, 236, 7881, 297, 7883, 243, 242, 7887, 245, 7885, 7889, 7891, 7893, 7895, 7897, 7899, 7901, 7903, 7905, 7907, 250, 249, 7911, 361, 7909, 7913, 7915, 7917, 7919, 7921, 253, 7923, 7927, 7929, 7925)
For j = 0 To UBound(aKT)
KT = KT & ChrW(aKT(j))
Thanh = Thanh & ChrW(aThanh(j))
Next j
End SubNếu dữ liệu lấy từ nhiều nguồn thì phải chú ý. Vì code không phục vụ unicode tổ hợp.
nghiank09
Thành viên hoạt động
- Tham gia
- 1/3/12
- Bài viết
- 143
- Được thích
- 30
Cám ơn bạn đã hỗ trợ. Mình đã test và kết quả đúng. Bạn có thể cho mình hỏi thêm dòng code
aThanh = Array(225, 224, 7843, 227, 7841, 7855, 7857, 7859, 7861, 7863, 7845, 7847, 7849, 7851, 7853, 233, 232, 7867, 7869, 7865, 7871, 7873, 7875, 7877, 7879, 237, 236, 7881, 297, 7883, 243, 242, 7887, 245, 7885, 7889, 7891, 7893, 7895, 7897, 7899, 7901, 7903, 7905, 7907, 250, 249, 7911, 361, 7909, 7913, 7915, 7917, 7919, 7921, 253, 7923, 7927, 7929, 7925)
là tập hợp các ký tự a,ă,â,u,ư,e,ê,o,ô,ơ,i,y kết hợp với 5 dấu: sắc, huyền, hỏi, ngã, nặng và không dấu phải không ạ
Bài đã được tự động gộp:
Cám ơn bạn rất nhiều
aThanh là mảng các mã Ascii của á, à, ả, ã, ạ .....Cám ơn bạn đã hỗ trợ. Mình đã test và kết quả đúng. Bạn có thể cho mình hỏi thêm dòng code
aThanh = Array(225, 224, 7843, 227, 7841, 7855, 7857, 7859, 7861, 7863, 7845, 7847, 7849, 7851, 7853, 233, 232, 7867, 7869, 7865, 7871, 7873, 7875, 7877, 7879, 237, 236, 7881, 297, 7883, 243, 242, 7887, 245, 7885, 7889, 7891, 7893, 7895, 7897, 7899, 7901, 7903, 7905, 7907, 250, 249, 7911, 361, 7909, 7913, 7915, 7917, 7919, 7921, 253, 7923, 7927, 7929, 7925)
là tập hợp các ký tự a,ă,â,u,ư,e,ê,o,ô,ơ,i,y kết hợp với 5 dấu: sắc, huyền, hỏi, ngã, nặng và không dấu phải không ạ
Bài đã được tự động gộp:
Cám ơn bạn rất nhiều
Tách như vậy mất công mà không làm gì được với làm thơ và nói lái đâu.
1. Làm thơ:
tuỳ theo thơ gì. Thơ lục bát thì chỉ cần trầm bình thanh và phù bình thanh. Thơ song thất lục bát thì nội dung quan trọng hơn hình thức. Tức là biết khi nào phải nhấn vần và hiệp vần
Nụ tầm xuân nở ra xanh biếc
Em (đã) có chồng anh tiếc lắm thay
biếc: màu xanh, hy vọng; vần với tiếc: mất mát. Một cặp đối chữ tuyệt hảo của văn chương bình dân Việt.
Thơ tám chữ thì cần nhịp chứ đâu cần thanh.
2. Nói lái:
việc phân thanh âm hoàn toàn vô bổ. Nói lái nằm trong thói quen, làm nhiều thì thạo. Hết.
Vả lại, cách phân tích của bạn chỉ có 6 thanh thì không đủ để nói lái. Nói lái liên quan đủ 8 thanh (như bài #4)
Ở đay ai cũng biết nghề trích từ và nói lái tôi đã đến mức tối thượng. Tôi có đủ thẩm quyền để phê phán điều này.
HeSanbi
Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨
- Tham gia
- 24/2/13
- Bài viết
- 2,382
- Được thích
- 3,536
- Giới tính
- Nam
@nghiank09
Bạn tham khảo Hàm UDF dưới đây để thực hiện cho mục đích của bạnGõ vào ô B2 công thức:
=S_Detach(A3:A10000)
Sao chép mã bên dưới vào một module
Lưu ý: mã chỉ hoạt động trên hệ điều hành window
JavaScript:
' _,
' ___ _ _ _ ___(_)
'/ __| / \ | \| | _ | |
'\__ \/ \ \| \\ | _ \ |
'|___/_/ \_|_|\_|___/_|
'
Option Explicit
Option Compare Text
#If VBA7 Then
Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As LongPtr, ByVal lpTimerFunc As LongPtr) As Long
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
Private Declare Function SetTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
#End If
Enum EnumMarkOfWord
EMW_Outside = -1
EMW_NoMark = 0
EMW_graveAccent
EMW_Acute
EMW_Question
EMW_tilde
EMW_Dot
End Enum
Private Enum ArgsIndex
AGI_Action = 0
AGI_Formula
AGI_caller
AGI_Array
AGI_Target
End Enum
#If Win64 Then
Private gTimerID As LongPtr
#Else
Private gTimerID As Long
#End If
Private Args(), WorkIndex As Integer
Function S_Detach( _
Optional ByVal Target As Range) As Variant
On Error Resume Next
Dim K As Integer, R, Formula$
Set R = Application.Caller
Formula = R(1, 1).Formula
S_Detach = ChrW(194) & "m " & ChrW(273) & "" & ChrW(7847) & "u 1"
K = UBound(Args)
ReDim Preserve Args(1 To K + 1)
Args(K + 1) = VBA.Array(0, Formula, R, 0, Target)
If gTimerID = 0 Then
gTimerID = SetTimer(0&, 0&, 1, AddressOf S_Detach_callback)
End If
End Function
Private Sub S_Detach_callback()
On Error Resume Next
Call KillTimer(0&, gTimerID): gTimerID = 0
S_Detach_working
On Error GoTo 0
End Sub
Private Sub S_Detach_working()
On Error Resume Next
Dim UA%, s$
UA = UBound(Args)
If UA > 0 Then
WorkIndex = WorkIndex + 1
Dim a: a = Args(WorkIndex)
If a(AGI_Action) <> 0 Or a(AGI_caller).Formula <> a(AGI_Formula) Then
GoTo n
End If
a(AGI_Action) = 1
'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//
Dim R1 As Range
Set R1 = a(AGI_Target)
Dim R&, c%, IsUp As Boolean, vowel$
Dim LR&, LC%, mc%, Text$, sp$(), Arr, total(), Title()
LC = R1.Columns.Count
LR = R1.Rows.Count
LR = R1(LR + 4, 1).End(3).Row - R1.Row + 1
If LR > 0 Then
Arr = R1(1, 1).Resize(LR, 1).Value
For R = 1 To LR
Text = Application.WorksheetFunction.Trim(Arr(R, 1))
If Len(Text) > 0 Then
sp = Split(Text, " ")
If UBound(sp) + 1 > mc Then
mc = UBound(sp) + 1
ReDim Preserve Title(1 To mc * 3 - 1)
ReDim Preserve total(1 To LR, 1 To mc * 3)
For c = 1 To UBound(sp) + 1
If c > 1 Then
Title((c - 1) * 3 + 0) = ChrW(194) & "m " & ChrW(273) & "" & ChrW(7847) & "u " & c
End If
Title((c - 1) * 3 + 1) = "V" & ChrW(7847) & "n " & c
Title((c - 1) * 3 + 2) = "Thanh " & c
Next
End If
For c = 0 To UBound(sp)
total(R, (c) * 3 + 1) = consonant(sp(c), vowel)
total(R, (c) * 3 + 2) = rhythmNoMark(vowel)
total(R, (c) * 3 + 3) = MeanMarkOfVowel(vowel)
Next
End If
Next R
a(AGI_caller)(1, 2).Resize(1, mc * 3 - 1).Value = Title
a(AGI_caller)(2, 1).Resize(LR, mc * 3).Value = total
a(AGI_Action) = 2
End If
Set R1 = Nothing
'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//
n:
If WorkIndex >= UA Then
Erase Args: WorkIndex = 0
Else
gTimerID = SetTimer(0&, 0&, 1, AddressOf S_Detach_callback)
End If
End If
On Error GoTo 0
End Sub
Function MeanMarkOfVowel(ByVal vowel$) As String
MeanMarkOfVowel = mark2Mean(markofvowel(vowel))
End Function
Function mark2Mean(mark&)
Select Case mark
Case EMW_graveAccent: mark2Mean = "Huy" & ChrW(7873) & "n"
Case EMW_Acute: mark2Mean = "S" & ChrW(7855) & "c"
Case EMW_Question: mark2Mean = "H" & ChrW(7887) & "i"
Case EMW_tilde: mark2Mean = "Ng" & ChrW(227)
Case EMW_Dot: mark2Mean = "N" & ChrW(7863) & "ng"
Case EMW_NoMark: mark2Mean = "B" & ChrW(7857) & "ng"
Case Else: mark2Mean = "Kh" & ChrW(225) & "c"
End Select
End Function
Function markofvowel(ByVal vowel$) As EnumMarkOfWord
Dim i%, t$, v&
markofvowel = EMW_Outside
For i = 1 To Len(vowel)
t = Mid(vowel, i, 1)
Select Case AscW(t)
Case &H61, &H103, &HE2, &H65, &HEA, &H69, &H6F, &HF4, &H1A1, &H75, &H1B0, &H79, &H41, &H102, &HC2, &H45, &HCA, &H49, &H4F, &HD4, &H1A0, &H55, &H1AF, &H59
markofvowel = EMW_NoMark
Case &HE1, &H1EAF, &H1EA5, &HE9, &H1EBF, &HED, &HF3, &H1ED1, &H1EDB, &HFA, &H1EE9, &HFD, &HC1, &H1EAE, &H1EA4, &HC9, &H1EBE, &HCD, &HD3, &H1ED0, &H1EDA, &HDA, &H1EE8, &HDD
markofvowel = EMW_Acute
Case &HE0, &H1EB1, &H1EA7, &HE8, &H1EC1, &HEC, &HF2, &H1ED3, &H1EDD, &HF9, &H1EEB, &H1EF3, &HC0, &H1EB0, &H1EA6, &HC8, &H1EC0, &HCC, &HD2, &H1ED2, &H1EDC, &HD9, &H1EEA, &H1EF2
markofvowel = EMW_graveAccent
Case &H1EA3, &H1EB3, &H1EA9, &H1EBB, &H1EC3, &H1EC9, &H1ECF, &H1ED5, &H1EDF, &H1EE7, &H1EED, &H1EF7, &H1EA2, &H1EB2, &H1EA8, &H1EBA, &H1EC2, &H1EC8, &H1ECE, &H1ED4, &H1EDE, &H1EE6, &H1EEC, &H1EF6
markofvowel = EMW_Question
Case &HE3, &H1EB5, &H1EAB, &H1EBD, &H1EC5, &H129, &HF5, &H1ED7, &H1EE1, &H169, &H1EEF, &H1EF9, &HC3, &H1EB4, &H1EAA, &H1EBC, &H1EC4, &H128, &HD5, &H1ED6, &H1EE0, &H168, &H1EEE, &H1EF8
markofvowel = EMW_tilde
Case &H1EA1, &H1EB7, &H1EAD, &H1EB9, &H1EC7, &H1ECB, &H1ECD, &H1ED9, &H1EE3, &H1EE5, &H1EF1, &H1EF5, &H1EA0, &H1EB6, &H1EAC, &H1EB8, &H1EC6, &H1ECA, &H1ECC, &H1ED8, &H1EE2, &H1EE4, &H1EF0, &H1EF4
markofvowel = EMW_Dot
End Select
Next
End Function
Function VowelNoMark(ByVal vowel) As String
Dim v&, t&
If IsNumeric(vowel) Then
t = vowel
Else
t = AscW(vowel)
End If
Select Case t
Case &H61, &HE1, &HE0, &H1EA3, &HE3, &H1EA1: v = &H61
Case &H103, &H1EAF, &H1EB1, &H1EB3, &H1EB5, &H1EB7: v = &H103
Case &HE2, &H1EA5, &H1EA7, &H1EA9, &H1EAB, &H1EAD: v = &HE2
Case &H65, &HE9, &HE8, &H1EBB, &H1EBD, &H1EB9: v = &H65
Case &HEA, &H1EBF, &H1EC1, &H1EC3, &H1EC5, &H1EC7: v = &HEA
Case &H69, &HED, &HEC, &H1EC9, &H129, &H1ECB: v = &H69
Case &H6F, &HF3, &HF2, &H1ECF, &HF5, &H1ECD: v = &H6F
Case &HF4, &H1ED1, &H1ED3, &H1ED5, &H1ED7, &H1ED9: v = &HF4
Case &H1A1, &H1EDB, &H1EDD, &H1EDF, &H1EE1, &H1EE3: v = &H1A1
Case &H75, &HFA, &HF9, &H1EE7, &H169, &H1EE5: v = &H75
Case &H1B0, &H1EE9, &H1EEB, &H1EED, &H1EEF, &H1EF1: v = &H1B0
Case &H79, &HFD, &H1EF3, &H1EF7, &H1EF9, &H1EF5: v = &H79
'UCase
Case &H41, &HC1, &HC0, &H1EA2, &HC3, &H1EA0: v = &H41
Case &H102, &H1EAE, &H1EB0, &H1EB2, &H1EB4, &H1EB6: v = &H102
Case &HC2, &H1EA4, &H1EA6, &H1EA8, &H1EAA, &H1EAC: v = &HC2
Case &H45, &HC9, &HC8, &H1EBA, &H1EBC, &H1EB8: v = &H45
Case &HCA, &H1EBE, &H1EC0, &H1EC2, &H1EC4, &H1EC6: v = &HCA
Case &H49, &HCD, &HCC, &H1EC8, &H128, &H1ECA: v = &H49
Case &H4F, &HD3, &HD2, &H1ECE, &HD5, &H1ECC: v = &H4F
Case &HD4, &H1ED0, &H1ED2, &H1ED4, &H1ED6, &H1ED8: v = &HD4
Case &H1A0, &H1EDA, &H1EDC, &H1EDE, &H1EE0, &H1EE2: v = &H1A0
Case &H55, &HDA, &HD9, &H1EE6, &H168, &H1EE4: v = &H55
Case &H1AF, &H1EE8, &H1EEA, &H1EEC, &H1EEE, &H1EF0: v = &H1AF
Case &H59, &HDD, &H1EF2, &H1EF6, &H1EF8, &H1EF4: v = &H59
End Select
If v > 0 Then
VowelNoMark = ChrW(v)
Else
VowelNoMark = vowel
End If
End Function
Function consonant(ByVal Word$, Optional ByRef vowel As String) As String
On Error Resume Next
Dim cons, c
cons = Array("ngh", "gi", "ch", "gh", "kh", "ng", "nh", "ph", "qu", "th", "tr", "b", "c", "d", "h", "k", "l", "m", "n", "r", "s", "t", "v", "x", "p", "g", ChrW(272), ChrW(273))
For Each c In cons
If Left(Word, Len(c)) = c Then
consonant = c
vowel = Mid(Word, Len(c) + 1)
Exit For
End If
Next
If consonant = vbNullString Then
vowel = Word
End If
On Error GoTo 0
End Function
Private Sub rhythmNoMark_test()
Debug.Print rhythmNoMark("ti" & ChrW(7871) & "t")
End Sub
Function rhythmNoMark(ByVal Word As String) As String
Dim i%, t$, v&, s$
For i = 1 To Len(Word)
t = Mid(Word, i, 1)
Select Case AscW(t)
Case &H61, &H103, &HE2, &H65, &HEA, &H69, &H6F, &HF4, &H1A1, &H75, &H1B0, &H79, &H41, &H102, &HC2, &H45, &HCA, &H49, &H4F, &HD4, &H1A0, &H55, &H1AF, &H59
s = s & VowelNoMark(t)
Case &HE1, &H1EAF, &H1EA5, &HE9, &H1EBF, &HED, &HF3, &H1ED1, &H1EDB, &HFA, &H1EE9, &HFD, &HC1, &H1EAE, &H1EA4, &HC9, &H1EBE, &HCD, &HD3, &H1ED0, &H1EDA, &HDA, &H1EE8, &HDD
s = s & VowelNoMark(t)
Case &HE0, &H1EB1, &H1EA7, &HE8, &H1EC1, &HEC, &HF2, &H1ED3, &H1EDD, &HF9, &H1EEB, &H1EF3, &HC0, &H1EB0, &H1EA6, &HC8, &H1EC0, &HCC, &HD2, &H1ED2, &H1EDC, &HD9, &H1EEA, &H1EF2
s = s & VowelNoMark(t)
Case &H1EA3, &H1EB3, &H1EA9, &H1EBB, &H1EC3, &H1EC9, &H1ECF, &H1ED5, &H1EDF, &H1EE7, &H1EED, &H1EF7, &H1EA2, &H1EB2, &H1EA8, &H1EBA, &H1EC2, &H1EC8, &H1ECE, &H1ED4, &H1EDE, &H1EE6, &H1EEC, &H1EF6
s = s & VowelNoMark(t)
Case &HE3, &H1EB5, &H1EAB, &H1EBD, &H1EC5, &H129, &HF5, &H1ED7, &H1EE1, &H169, &H1EEF, &H1EF9, &HC3, &H1EB4, &H1EAA, &H1EBC, &H1EC4, &H128, &HD5, &H1ED6, &H1EE0, &H168, &H1EEE, &H1EF8
s = s & VowelNoMark(t)
Case &H1EA1, &H1EB7, &H1EAD, &H1EB9, &H1EC7, &H1ECB, &H1ECD, &H1ED9, &H1EE3, &H1EE5, &H1EF1, &H1EF5, &H1EA0, &H1EB6, &H1EAC, &H1EB8, &H1EC6, &H1ECA, &H1ECC, &H1ED8, &H1EE2, &H1EE4, &H1EF0, &H1EF4
s = s & VowelNoMark(t)
Case Else
s = s & t
End Select
Next
rhythmNoMark = s
End Function
Private Sub sellconsonants_test()
Debug.Print sellconsonants("c" & VBA.ChrW(7843) & "m")
End Sub
Function sellconsonants(ByVal Word$, Optional ByRef vowel As String) As String
Call consonant(Word, Word)
On Error Resume Next
Dim c
For Each c In Array("nh", "ng", "ch", "c", "m", "n", "t", "p")
If Right(Word, Len(c)) = c Then
sellconsonants = c
vowel = Left(Word, Len(Word) - Len(c))
Exit For
End If
Next
On Error GoTo 0
End Function
Lần chỉnh sửa cuối:
nghiank09
Thành viên hoạt động
- Tham gia
- 1/3/12
- Bài viết
- 143
- Được thích
- 30
Cám ơn bạn đã hỗ trợ
.
