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

Excel VBA Cell Auto Advance Sub Splitting Words

1 个答案: