Excel VBA单元格自动超前子拆分单词

Question

我目前在Excel工作表中有一个VBA子例程，它提示用户使用输入框，将数据插入单元格，如果整个字符串将自动前进到单元格不适合单个细胞。它可以工作，但是代码将会前进到下一行，即使它必须分割一个单词才能完成。我不希望这样，我希望提出一些关于如何改进我的代码的建议，以便Excel不仅可以推进单元格，还可以使单元格不会被截断。

Sub AutoCellAdvance() 

If bolEditMode = True Then 
    Exit Sub 
End If 

Dim str As String, x As Integer, y As Integer 

intPlaceholder = Sheet1.Range("AE1").Value 

If IsEmpty(ActiveCell) Then 
    str = InputBox("Enter Description of Activities (Max 192 characters)", "Incidents, Messages, Orders, Etc.") 
    y = 0 
    For x = 1 To Len(str) Step 64 
     ActiveCell.Offset(y, 0) = "" & Mid(str, x, 64) 
     If Len(str) > 64 And Len(str) <= 128 And intPlaceholder = 6 Then 
     ActiveCell.Offset(1, -4).Resize(1, 4).Value = Chr(151) & Chr(151) 
     End If 
     If Len(str) > 128 And Len(str) < 192 And intPlaceholder = 6 Then 
     ActiveCell.Offset(1, -4).Resize(2, 4).Value = Chr(151) & Chr(151) 
     End If 
     If Len(str) >= 192 And intPlaceholder = 6 Then 
     ActiveCell.Offset(1, -4).Resize(3, 4).Value = Chr(151) & Chr(151) 
     End If 
     y = y + 1 
    Next 

Else 
Exit Sub 
End If 

End Sub 


Private Sub Worksheet_SelectionChange(ByVal target As Range) 

'Incident, Messages, Orders, Etc. Input 
Dim rng As Range 
Set rng = Intersect(target, Range("N12,N13,N14,N15,N16,N17,N18,N19,N20,N21,N22,N23,N24,N25,N26,N27,N28,N29,N30,N31,N32,N33,N34,N35,N36,N37,N38,N39,N40,N41,N42,N43,N44")) 
If rng Is Nothing Then 
    Exit Sub 
ElseIf target.Count > 14 Then 
    Exit Sub 
Else 
    Dim cl As Range 
    For Each cl In rng 
     AutoCellAdvance 
    Next cl 
End If 

Selection.Font.Name = "arial" 
Selection.Font.Size = 10 

End Sub 

Answer 1

试试这个。下面的代码将输入字符串拆分为基于分隔符“”的字符串数组。然后它遍历字符串数组。只要它达到64的大小，它就会进入下一行。

Sub AutoCellAdvance() 

Dim strTemp As String 
Dim arrStrings() As String 
Dim i As Integer 
Dim strNew As String 

Range("A1").Activate 

strTemp = InputBox("Enter Description of Activities (Max 192 characters)", "Incidents, Messages, Orders, Etc.") 
'splits the string based on the delimeter space 
arrStrings = Split(strTemp, " ") 
strNew = "" 
'loops through the strings 
For i = LBound(arrStrings) To UBound(arrStrings) 
    If Len(strNew + arrStrings(i)) < 64 Then 
     'as long as its smaller than 64 its adds the string to the rest of the strings 
     strNew = strNew + arrStrings(i) + " " 
    Else 
     'if its larger than 64 then it prints the value in the active cell and goes down a row 
     ActiveCell = strNew 
     strNew = arrStrings(i) 
     Range(Cells(ActiveCell.Row + 1, ActiveCell.Column), Cells(ActiveCell.Row + 1, ActiveCell.Column)).Activate 
    End If 

Next i 
ActiveCell = strNew 

End Sub 

另外这里有一篇文章，我写了关于我的博客字符串处理。它还谈到了分割字符串。 String Processing