时间戳

首页 > 解决方案 > 使用 VBA 表：如果要插入的字符串中有 + 号，则拆分单元格

vba - 使用 VBA 表：如果要插入的字符串中有 + 号，则拆分单元格

问题描述

我是一个 VB 用户，他必须倒退并尝试使 VBA 代码在 Word 中工作。我有一个 .dotm 文件，其中包含用户窗体在初始化时“清理”的表和数据。客户启动他们自己的文档，并且可以插入从我的 .dotm 复制的“起始表格”。在这些表格中，用户转到一个空白单元格并从用户窗体中选择一个按钮以将文本插入该单元格。如果与按钮关联的文本有加号，我想拆分用户所在的单元格，并拆分字符串，以便一个在“原始”单元格中，另一个在新创建的通过拆分细胞。我有用于拆分用户选择的单元格的代码，但是在引用原始单元格和新创建的单元格时遇到了麻烦。这是代码，改编自类似的拆分代码：

Public Sub SelectionInfo(ByVal RememberMyText As String)
     '
    Dim iSelectionRowEnd As Integer
    Dim iSelectionRowStart As Integer
    Dim iSelectionColumnEnd As Integer
    Dim iSelectionColumnStart As Integer
    Dim lngStart As Long
    Dim lngEnd As Long
     Dim numberOfColumnsInCurrentTable As Integer
        Dim currentTableIndex As Integer

     ' Check if Selection IS in a table
     ' if not, exit Sub after message
    If Selection.Information(wdWithInTable) = False Then
        MsgBox "Selection is not in a table.  Exiting macro."
    Else

        currentTableIndex = ActiveDocument.Range(0, Selection.Tables(1).Range.End).Tables.Count
        NumberOfColumns = ActiveDocument.Tables(currentTableIndex).Columns.Count
        MsgBox ("Current table is # " & currentTableIndex)


        lngStart = Selection.Range.Start
        lngEnd = Selection.Range.End

         ' get the numbers for the END of the selection range
        iSelectionRowEnd = Selection.Information(wdEndOfRangeRowNumber)
        iSelectionColumnEnd = Selection.Information(wdEndOfRangeColumnNumber)

         ' collapse the selection range
        Selection.Collapse Direction:=wdCollapseStart

         ' get the numbers for the END of the selection range
         ' now of course the START of the previous selection
        iSelectionRowStart = Selection.Information(wdEndOfRangeRowNumber)
        iSelectionColumnStart = Selection.Information(wdEndOfRangeColumnNumber)

         ' RESELECT the same range
        Selection.MoveEnd Unit:=wdCharacter, Count:=lngEnd - lngStart

         ' display the range of cells covered by the selection
        MsgBox "The selection covers " & Selection.Cells.Count & " cells, from Cell(" & _
        iSelectionRowStart & "," & iSelectionColumnStart & ") to Cell(" & _
        iSelectionRowEnd & "," & iSelectionColumnEnd & ")."

        Dim counter As Integer
        counter = 0

        For j = 1 To Len(RememberMyText)
            If Mid(RememberMyText, j, 1) = "+" Or Mid(RememberMyText, j, 1) = "-" Then
                counter = counter + 1
            End If
        Next j
        If counter > 0 Then
            MsgBox ("There were " & counter & " symbols..")
            'ActiveDocument.SelectionTables(1).Cell(iSelectionRowStart, iSelectionColumnStart).Split Numrows:=1, NumColumns:=2, MergeBeforeSplit:=False

            'ActiveDocument.SelectionTables(1).Cell(iSelectionRowStart, iSelectionColumnStart).Range.Select
            If counter = 1 Then
            Selection.Cells.Split Numrows:=1, NumColumns:=2, Mergebeforesplit:=True 'False
            'now split the text and redistribute it into the two cells, same row, different column for other half of original string

            Dim Result() As String
            Result() = Split(RememberMyText)
            Dim rng As Range
            rng = ActiveDocument.Tables(currentTableIndex).Rows(iSelectionRowStart).Cells(iSelectionColumnStart).Range
            'also tried: rng = ActiveDocument.Tables(currentTableIndex).Cells(iSelectionRowStart,iSelectionColumnStart).Range
            Selection.TypeText ("")
            Selection.TypeText (Result(0))
            rng = ActiveDocument.Tables(currentTableIndex).Rows(iSelectionRowStart).Cells(iSelectionColumnStart + 1).Range
            'also tried: rng = ActiveDocument.Tables(currentTableIndex).Cells(iselectionRowStart,iSelectionColumnStart + 1).Range
            Selection.TypeText (Result(1))


            ElseIf counter = 2 Then
            Selection.Cells.Split Numrows:=1, NumColumns:=3, Mergebeforesplit:=True 'False ' also switched true and false
'still working on this one, it would be the same issue.
            End If


        End If


    End If
End Sub

单元格拆分OK，将原始文本留在一个单元格中，新创建的单元格为空。我只想“重做”这两个单元格（或者如果原始字符串中有两个加号，则重做三个单元格）我只是一个中级人员；非常感谢任何帮助。谢谢

标签： vbasplitms-wordcellword-table

解决方案

尝试：

Public Sub SelectionInfo(ByVal RememberMyText As String)
Application.ScreenUpdating = False
Dim Rng As Range, StrAddr As String, i As Long, j As Long
With Selection
  Set Rng = .Range
  ' Check if Selection IS in a table. If not, exit after message
  If .Information(wdWithInTable) = True Then
    StrAddr = "The selected cell"
    If .Cells.Count = 1 Then
      StrAddr = StrAddr & " address is: "
    Else
      StrAddr = StrAddr & "s span: "
    End If
    StrAddr = StrAddr & ColAddr(.Cells(1).ColumnIndex) & .Cells(1).RowIndex
    If .Cells.Count > 1 Then
      StrAddr = StrAddr & ":" & ColAddr(.Characters.Last.Cells(1).ColumnIndex) & _
        .Characters.Last.Cells(1).RowIndex
    End If
    StrAddr = StrAddr & " of Table: " & _
      ActiveDocument.Range(0, Selection.Tables(1).Range.End).Tables.Count
    MsgBox StrAddr
    RememberMyText = Replace(Replace(RememberMyText, "+", "¶"), "-", "¶")
    j = UBound(Split(RememberMyText, "?"))
    If j > 0 Then
      'create new cells
      Rng.Cells(1).Split Numrows:=1, NumColumns:=j + 1
    End If
    'now split the text and redistribute it into the cells
    For i = 0 To j
      Rng.Cells(i + 1).Range.Text = Split(RememberMyText, "¶")(i)
    Next
  Else
      MsgBox "Selection is not in a table.  Exiting macro."
  End If
End With
Application.ScreenUpdating = True
End Sub

Function ColAddr(i As Long) As String
If i > 26 Then
  ColAddr = Chr(64 + Int(i / 26)) & Chr(64 + (i Mod 26))
Else
  ColAddr = Chr(64 + i)
End If
End Function

推荐阅读