erwin字段中英文转换-VBA模拟器


Dim str_nfd As String '缓存暂时还没有找到对应英文单词的中文字段
Dim str_fd As String '缓存已经找到对应英文单词的中文字段

Dim str_map_path As String '中英文映射txt文件位置 "D:\rdw\docs\AttrC2E.txt"


'函数功能描述:给出一个中文词组,返回一个英文词组,找不到对应英文词组的话则返回 "-100"
'入参:chnstr 要转换的中文词组

Function getengwrd(chnstr As String)

'函数功能:给出汉字词组,获取对应英文词组
Dim engstr As String
Dim chnstrs() As String
Dim engstrs() As String
Dim cnt As Integer
cnt = 0
getengwrd = "-100"
'把Sheet2中的字段标准与英文映射读取到数组中去

'MsgBox (Sheet2.UsedRange.Rows.Count) 把 Sheet2 改成别的名称会报错 ,UsedRange.Rows.Count 就会取不到值,再探查

'方式1---->>excel sheet页中读取属性映射表的方式

' For i = 1 To Sheet2.UsedRange.Rows.Count
' ReDim Preserve chnstrs(cnt)
' ReDim Preserve engstrs(cnt)
' cnt = cnt + 1
' chnstrs(cnt - 1) = Sheet2.Cells(i, 1).Value '存到动态数组里去
' engstrs(cnt - 1) = Sheet2.Cells(i, 2).Value '存到动态数组里去
' Next i
' '读取数据完毕


'方式2---->>txt本地文件中读取属性映射表的方式


Dim str_txt As String
Open str_map_path For Input As #1
Do While Not EOF(1)
Line Input #1, str_txt

ReDim Preserve chnstrs(cnt)
ReDim Preserve engstrs(cnt)
cnt = cnt + 1
chnstrs(cnt - 1) = Left(str_txt, InStr(str_txt, ",") - 1) '存到动态数组里去
engstrs(cnt - 1) = Right(str_txt, Len(str_txt) - InStr(str_txt, ",")) '存到动态数组里去

'''### debug log --->> MsgBox ("01-->>" & Left(str_txt, InStr(str_txt, ",") - 1))

'''### debug log --->> MsgBox ("01-->>" & Right(str_txt, Len(str_txt) - InStr(str_txt, ",")))
Loop

Close #1 '关闭文件输入流

For j = 0 To UBound(chnstrs)

If chnstrs(j) = chnstr Then
getengwrd = engstrs(j)

Exit For
End If

Next

End Function

'函数功能描述:按照从长到短的分词原则翻译中文字段(以字符串的右侧index为基准)
'

Function getengwrdall(ByVal chnstr As String) As String

Dim chnstrlen As Integer
Dim strtmp As String
strtmp = ""
Dim str_rst As String
chnstrlen = Len(chnstr)


'''### debug log --->> MsgBox ("Now go to find-1:" & chnstr)


If (chnstr = "" Or chnstr = Null) Then '判断是否开始匹配
'''### debug log --->> MsgBox ("No word need to transelate, it's the end !")
Return

Else
'如果输入参数不为空,那么 则进行中英文参数匹配
'''### debug log --->> MsgBox ("Now transelate, chnstr=" & getengwrd(chnstr))
str_rst = getengwrd(chnstr)

If (str_rst <> "-100" Or (str_rst = "-100" And (Len(chnstr) = 1))) Then
'如果已经找到英文字符串,或者虽然没有找到英文字符串,但是当前字符已经是最后一个字符
'那么返回找到的英文字符串或者,返回单个字符本身

If str_rst = "-100" And (Len(chnstr) = 1) Then
str_rst = chnstr
End If

str_fd = (str_rst & str_fd) '把翻译过来的字符串记录到公共缓缓冲区
'''### debug log --->> MsgBox ("Now first loop is end 。str_fd=" & str_fd)

'小递归
'在当前循环已经结束的情况下, 判断一下当前str_nfd缓冲区里面是否仍有需要翻译的词组,如果没有,什么也不做
'如果str_nfd中有字符串那么对str_nfd进行翻译,同时清空str_nfd
strtmp = str_nfd
str_nfd = ""

If (strtmp <> "") Then
'''### debug log --->> MsgBox ("Now loop the little strtmp=" & strtmp)
getengwrdall (strtmp)
End If

Else
str_nfd = (str_nfd & Left(chnstr, 1)) '左边空出来的字符,纳入str_nfd的字符串缓冲区,等待下一轮递归使用
'''### debug log --->> MsgBox ("push the 【" & Left(chnstr, 1) & "】 in to str_nfd, and now str_nfd=【" & str_nfd & "】")

getengwrdall (Right(chnstr, Len(chnstr) - 1)) '右错一位进行剩下的字符串查找

End If

End If '判断是否开始匹配 -end


End Function


Function erwintrs(chnstr As String)

Dim str_rtn As String '定义返回的参数

str_nfd = ""
str_fd = ""
str_map_path = "D:\rdw\docs\AttrC2E.txt"

'''### debug log --->> MsgBox ("01是" & " now in test")
getengwrdall (chnstr)
'''### debug log --->> MsgBox ("the end str_fd=" & str_fd)

'如果结果首字符是"_",则去掉首字符

If (str_fd <> "" And Left(str_fd, 1) = "_") Then

str_fd = Right(str_fd, Len(str_fd) - 1)

End If


'替换特殊字符
If (str_fd <> "") Then
str_fd = Replace(str_fd, "(", "")
str_fd = Replace(str_fd, ")", "")
str_fd = Replace(str_fd, "-", "")
str_fd = Replace(str_fd, "(", "")
str_fd = Replace(str_fd, ")", "")
End If
erwintrs = str_fd

End Function


Function testerwintrs()

erwintrs ("贷款类型代码")


End Function

posted @ 2020-01-06 10:17  bjxdd  阅读(627)  评论(0)    收藏  举报