我有一个子设计用于将带有描述的字符串剪切成段,然后使用“Text to Column”将其存储在拆分段中的工作表上,以便可以将它们单独加载到自定义弹出窗口中。我的问题是它总是剪切并删除字符串中的最后一个单词。我显然错过了一些东西,因为我看不出它有什么不妥。任何人都可以告诉我为什么我一直在放弃最后一句话
Sub CutStringLength(ByVal NoteInput As String, ByVal ControlCall As String)
'"NoteInput" is a string from a inputbox
'"ControlCall" is a variable name used in sheets, controls and functions
Dim AlteredString As String
Dim InnerLoop As Long, StringLimit As Long
Dim StartString As Variant
AlteredString = ""
StringLimit = 35
StartString = Split(NoteInput, " ")
For InnerLoop = LBound(StartString) To UBound(StartString)
If InnerLoop < UBound(StartString) Then
AlteredString = AlteredString & StartString(InnerLoop) & " "
If (Len(AlteredString) + Len(StartString(InnerLoop + 1))) > StringLimit Then
AlteredString = AlteredString & "|"
StringLimit = Len(AlteredString) + 35
End If
End If
Next
AlteredString = Trim(AlteredString)
Worksheets(ControlCall).Range("BS2").Value = AlteredString
Worksheets(ControlCall).Select
Range("BS2").Select
Selection.TextToColumns Destination:=Range("BS2"),DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, _
OtherChar:="|", FieldInfo:=Array(1, 1), TrailingMinusnumbers:=True
End Sub
答案 0 :(得分:0)
使用InStrRev从最大位置向后查找第一个空格。
Option Explicit
Sub test()
Dim pcs As Variant
Cells(1, "B") = splitString(Cells(1, "A").Value2)
pcs = Split(Cells(1, "B").Value2, Chr(124))
Cells(2, "B").Resize(1, UBound(pcs) + 1) = pcs
End Sub
Function splitString(str As String, Optional n As Long = 60)
Dim p As Long, w As Long, words() As Variant
Do While Len(Trim(str)) > n And CBool(InStr(1, str, Chr(32)))
p = InStrRev(str, Chr(32), n)
ReDim Preserve words(w)
words(w) = Trim(Left(str, p))
str = Trim(Mid(str, p))
w = w + 1
Loop
ReDim Preserve words(w)
words(w) = Trim(str)
splitString = Join(words, Chr(124))
End Function
无需使用TextToColumns。您可以将调整后的字符串拆分为变量数组,并将值直接传递到工作表中。