276、如何把符串中的一子串替换为另一子串？
277、如何把数字转换成汉字大写金额？
278、如何查找替代字符串？
279、如何从HTM文件中提取文本？
280、如何从全路径名中分离出路径？
276、如何把符串中的一子串替换为另一子串
'替换一行中第一个字符串
Function sReplace(SearchLine
As String, SearchFor As String, ReplaceWith As String)
Dim vSearchLine
As String, found As Integer
found = InStr(SearchLine, SearchFor):
vSearchLine = SearchLine
If found <> 0 Then
vSearchLine =
""
If found > 1 Then vSearchLine = Left(SearchLine, found -
1)
vSearchLine = vSearchLine + ReplaceWith
If found + Len(SearchFor)
- 1 < Len(SearchLine) Then _
vSearchLine = vSearchLine +
Right$(SearchLine, Len(SearchLine) - found - Len(SearchFor) + 1)
End
If
sReplace = vSearchLine
End Function
277、如何把数字转换成汉字大写金额？
'调用方法Text2 = ChMoney(Val(Text1))
' 名称：
CCh
' 得到一位数字 N1 的汉字大写
' 0 返回 ""
Private Function CCh(N1) As
String
Select Case N1
Case 0
CCh = "零"
Case 1
CCh =
"壹"
Case 2
CCh = "贰"
Case 3
CCh = "叁"
Case 4
CCh =
"肆"
Case 5
CCh = "伍"
Case 6
CCh = "陆"
Case 7
CCh =
"柒"
Case 8
CCh = "捌"
Case 9
CCh = "玖"
End Select
End
Function
'名称： ChMoney
'得到数字 N1 的汉字大写
'最大为 千万位
'O 返回
""
Public Function ChMoney(N1) As String
Dim tMoney As String
Dim
lMoney As String
Dim tn '小数位置
Dim s1 As String '临时STRING 小数部分
Dim
s2 As String '1000 以内
Dim s3 As String '10000
If N1 = 0
Then
ChMoney = " "
Exit Function
End If
If N1 < 0
Then
ChMoney = "负" + ChMoney(Abs(N1))
Exit Function
End
If
tMoney = Trim(Str(N1))
tn = InStr(tMoney, ".") '小数位置
s1 =
""
If tn <> 0 Then
ST1 = Right(tMoney, Len(tMoney) - tn)
If
ST1 <> "" Then
t1 = Left(ST1, 1)
ST1 = Right(ST1, Len(ST1) -
1)
If t1 <> "0" Then
s1 = s1 + CCh(Val(t1)) + "角"
End
If
If ST1 <> "" Then
t1 = Left(ST1, 1)
s1 = s1 +
CCh(Val(t1)) + "分"
End If
End If
ST1 = Left(tMoney, tn -
1)
Else
ST1 = tMoney
End If
s2 = ""
If ST1 <> ""
Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
s2 =
CCh(Val(t1)) + s2
End If
If ST1 <> "" Then
t1 = Right(ST1,
1)
ST1 = Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s2 =
CCh(Val(t1)) + "拾" + s2
Else
If Left(s2, 1) <> "零" Then s2 =
"零" + s2
End If
End If
If ST1 <> "" Then
t1 = Right(ST1,
1)
ST1 = Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s2 =
CCh(Val(t1)) + "佰" + s2
Else
If Left(s2, 1) <> "零" Then s2 =
"零" + s2
End If
End If
If ST1 <> "" Then
t1 = Right(ST1,
1)
ST1 = Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s2 =
CCh(Val(t1)) + "仟" + s2
Else
If Left(s2, 1) <> "零" Then s2 =
"零" + s2
End If
End If
s3 = ""
If ST1 <> "" Then
t1 =
Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
s3 = CCh(Val(t1)) +
s3
End If
If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 =
Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s3 = CCh(Val(t1)) +
"拾" + s3
Else
If Left(s3, 1) <> "零" Then s3 = "零" + s3
End
If
End If
If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 =
Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s3 = CCh(Val(t1)) +
"佰" + s3
Else
If Left(s3, 1) <> "零" Then s3 = "零" + s3
End
If
End If
If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 =
Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s3 = CCh(Val(t1)) +
"仟" + s3
End If
End If
If Right(s2, 1) = "零" Then s2 = Left(s2,
Len(s2) - 1)
If Len(s3) > 0 Then
If Right(s3, 1) = "零" Then s3 =
Left(s3, Len(s3) - 1)
s3 = s3 & "万"
End If
ChMoney = IIf(s3
& s2 = "", s1, s3 & s2 & "元" & s1)
End Function
278、如何查找替代字符串？
'不知该怎么组织
'1****************************************************************************
Function
sReplace(SearchLine As String, SearchFor As String, ReplaceWith As
String)
Dim vSearchLine As String, found As Integer
found =
InStr(SearchLine, SearchFor)
vSearchLine = SearchLine
If found <
0 Then vSearchLine = ""
If found > 1 Then vSearchLine =
Left(SearchLine, found - 1)
vSearchLine = vSearchLine +
ReplaceWith
If found + Len(SearchFor) - 1 < Len(SearchLine)
Then
vSearchLine = vSearchLine + Right$(SearchLine, Len(SearchLine) -
found - Len(SearchFor) + 1)
End If
sReplace = vSearchLine
End
Function
'2****************************************************************************
Function
sReplace(SearchLine As String, SearchFor As String, ReplaceWith As
String)
Dim vSearchLine As String, found As Integer
found =
InStr(SearchLine, SearchFor)
vSearchLine = SearchLine
If found <
0 Then vSearchLine = ""
If found > 1 Then
vSearchLine =
Left(SearchLine, found - 1)
vSearchLine = vSearchLine +
ReplaceWith
If found + Len(SearchFor) - 1 < Len(SearchLine) Then
vSearchLine = vSearchLine + Right$(SearchLine, Len(SearchLine) - found -
Len(SearchFor) + 1)
End If
sReplace = vSearchLine
sReplace =
vSearchLine
279、如何从HTM文件中提取文本？
Public Function StripText(Path As String, FileName As String,
ExpandName As String) As String
Dim f, ff, is_tag, write2file, i
Dim
strTemp As String
Dim t As String
On Error Resume Next
f =
FreeFile
Open Path & FileName & "." & ExpandName For Input
As #f ' Open the HTML file in read mode
strTemp = GetTempFile("txt"):
StripText = strTemp
ff = FreeFile
Open strTemp For Output As
#ff
Do While Not EOF(f)
Line Input #f, t
write2file = ""
For i
= 1 To Len(t)
Select Case Mid(t, i, 1)
Case "<"
is_tag =
True
Case ">"
is_tag = False
Case Else
If Not is_tag Then
write2file = write2file & Mid(t, i, 1)
End Select
Next
Print
#ff, write2file
Loop
Close ff
Close f
Close f
280、如何从全路径名中分离出路径？
Function ExtractPath(sFileName) As
String
'*******************************************************************
'
'
PURPOSE: This returns just a path name from a full/partial path.
'
'
INPUTS: sFileName - String Data to remove file from.
'
' OUTPUTS:
N/A
'
' RETURNS: This function returns all the characters from left
to the last
' first \. Does NOT check validity of the
filename/Path....
'*******************************************************************
Dim
nIdx As Integer
For nIdx = Len(sFileName) To 1 Step -1
If
Mid$(sFileName, nIdx, 1) = "\" Then
ExtractPath = Mid$(sFileName, 1,
nIdx)
Exit Function
End If
Next nIdx
ExtractPath =
sFileName
End Function |