我想在Access中使用vba将文本框中的字符串拆分为多个文本框,每个框包含一个单词
所以说文本框名称text1
,它包含一个字符串,例如hello I'm asking a question
我想将该字符串拆分为文本框,所以就像
text2 = hello
text3 = I'm
text4 = asking
...etc
有一个简单的方法吗?
这是一个整洁的解决方案:ParseWord()函数
下面的代码有点冗长,但是一旦实现就易于使用。该代码的作用是在您的数据库项目中创建一个函数。该函数称为:ParseWord()。它不是内置函数。因此,为什么需要将代码添加到数据库项目中的模块。
Function ParseWord(varPhrase As Variant, ByVal iWordNum As Integer, Optional strDelimiter As String = " ", _
Optional bRemoveLeadingDelimiters As Boolean, Optional bIgnoreDoubleDelimiters As Boolean) As Variant
On Error GoTo Err_Handler 'I COMMENTED THIS OUT AND THE REFERENCE AT THE BOTTOM
'Purpose: Return the iWordNum-th word from a phrase.
'Return: The word, or Null if not found.
'Arguments: varPhrase = the phrase to search.
' iWordNum = 1 for first word, 2 for second, ...
' Negative values for words form the right: -1 = last word; -2 = second last word, ...
' (Entire phrase returned if iWordNum is zero.)
' strDelimiter = the separator between words. Defaults to a space.
' bRemoveLeadingDelimiters: If True, leading delimiters are stripped.
' Otherwise the first word is returned as null.
' bIgnoreDoubleDelimiters: If true, double-spaces are treated as one space.
' Otherwise the word between spaces is returned as null.
'Author: Allen Browne. http://allenbrowne.com. June 2006.
Dim varArray As Variant 'The phrase is parsed into a variant array.
Dim strPhrase As String 'varPhrase converted to a string.
Dim strResult As String 'The result to be returned.
Dim lngLen As Long 'Length of the string.
Dim lngLenDelimiter As Long 'Length of the delimiter.
Dim bCancel As Boolean 'Flag to cancel this operation.
'*************************************
'Validate the arguments
'*************************************
'Cancel if the phrase (a variant) is error, null, or a zero-length string.
If IsError(varPhrase) Then
bCancel = True
Else
strPhrase = Nz(varPhrase, vbNullString)
If strPhrase = vbNullString Then
bCancel = True
End If
End If
'If word number is zero, return the whole thing and quit processing.
If iWordNum = 0 And Not bCancel Then
strResult = strPhrase
bCancel = True
End If
'Delimiter cannot be zero-length.
If Not bCancel Then
lngLenDelimiter = Len(strDelimiter)
If lngLenDelimiter = 0& Then
bCancel = True
End If
End If
'*************************************
'Process the string
'*************************************
If Not bCancel Then
strPhrase = varPhrase
'Remove leading delimiters?
If bRemoveLeadingDelimiters Then
strPhrase = Nz(varPhrase, vbNullString)
Do While Left$(strPhrase, lngLenDelimiter) = strDelimiter
strPhrase = Mid(strPhrase, lngLenDelimiter + 1&)
Loop
End If
'Ignore doubled-up delimiters?
If bIgnoreDoubleDelimiters Then
Do
lngLen = Len(strPhrase)
strPhrase = Replace(strPhrase, strDelimiter & strDelimiter, strDelimiter)
Loop Until Len(strPhrase) = lngLen
End If
'Cancel if there's no phrase left to work with
If Len(strPhrase) = 0& Then
bCancel = True
End If
End If
'*************************************
'Parse the word from the string.
'*************************************
If Not bCancel Then
varArray = Split(strPhrase, strDelimiter)
If UBound(varArray) >= 0 Then
If iWordNum > 0 Then 'Positive: count words from the left.
iWordNum = iWordNum - 1 'Adjust for zero-based array.
If iWordNum <= UBound(varArray) Then
strResult = varArray(iWordNum)
End If
Else 'Negative: count words from the right.
iWordNum = UBound(varArray) + iWordNum + 1
If iWordNum >= 0 Then
strResult = varArray(iWordNum)
End If
End If
End If
End If
'*************************************
'Return the result, or a null if it is a zero-length string.
'*************************************
If strResult <> vbNullString Then
ParseWord = strResult
Else
ParseWord = Null
End If
Exit_Handler:
Exit Function
Err_Handler: 'I COMMENTED OUT THESE 4 LINES
Call LogError(Err.Number, Err.Description, "ParseWord()")
Resume Exit_Handler
End Function
将功能添加到数据库中的模块后,就可以像内置功能一样在VBA代码中调用它。
示例(点击事件):
我还必须注释掉“ On Error GoTo Err_Handler”行,因为我没有设置这些行。(我在代码中引用了这些)
本文收集自互联网,转载请注明来源。
如有侵权,请联系[email protected] 删除。
我来说两句