Question

我的表格中包含一系列值，如“5670＆amp;＆amp; 2”，“1281＆amp; -3＆amp; -5＆amp;＆amp; 7”，......等等。

请帮助我以下列方式在VBA中提取输出：

对于例如5670＆amp;＆amp; 2，我要求A1单元包含5670，B1单元包含＆amp;＆amp;，C1单元包含2。

对于Eg 1281＆amp;＆amp; -3＆amp; -5＆amp;＆amp; 7，我要求A1单元包含1281，B1单元包含＆amp;＆amp; - ，C1单元包含3，D1单元包含＆amp; - ，E1细胞含有5个，F1细胞含有＆amp;＆amp;和G1细胞含有7个。

请帮忙。

感谢。，

Answer 1

在这里，我试图编写代码来将数字与非数字分开。数字和非数字将复制到不同的列，例如Excel Text-To-Columns。代码有点疯狂，如果你需要我会提供评论。作为输入，使用ActiveSheet.UsedRange.Columns（1）.Cells。

Option Explicit

Sub SeparateNumbers()
  Dim targetRange As Range
  Dim cellRange As Range
  Dim charIndex As Integer
  Dim oneChar As String
  Dim nextChar As String
  Dim start As Integer
  Dim copiedCharsCount As Integer
  Dim cellValue As String
  Dim columnIndex As Integer

  Set targetRange = ActiveSheet.UsedRange.Columns(1).Cells

  For Each cellRange In targetRange
    columnIndex = cellRange.Column
    start = 1
    copiedCharsCount = 0
    cellValue = cellRange.Value
    If (VBA.Strings.Len(cellValue) <= 1) Then GoTo nextCell

    For charIndex = 2 To Len(cellValue)
      oneChar = VBA.Strings.Mid(cellValue, charIndex - 1, 1)
      nextChar = VBA.Strings.Mid(cellValue, charIndex, 1)
      If VBA.IsNumeric(oneChar) And VBA.IsNumeric(nextChar) Then GoTo nextCharLabel
      If Not VBA.IsNumeric(oneChar) And Not VBA.IsNumeric(nextChar) Then GoTo nextCharLabel

      cellRange.Offset(0, columnIndex).Value = VBA.Strings.Mid(cellValue, start, charIndex - start)
      columnIndex = columnIndex + 1
      copiedCharsCount = copiedCharsCount + (charIndex - start)
      start = charIndex

nextCharLabel:
      If charIndex = Len(cellValue) Then
        cellRange.Offset(0, columnIndex).Value = VBA.Strings.Right(cellValue, charIndex - copiedCharsCount)
      End If
    Next charIndex

nextCell:
  Next cellRange
End Sub

Answer 2

这是另外一个代码。作为副产品，函数TextSplitToNumbersAndOther可以作为公式独立使用，以达到同样的效果。

为了防止在错误的工作表或错误的列中意外触发宏并用废料覆盖相邻列，应由用户定义命名范围“Start_point”。在同一列的此范围之下，将处理所有数据直到第一个空行。

电子表格示例：http://www.bumpclub.ee/~jyri_r/Excel/Extracting_symbols_into_columns.xls

选项明确

Sub ExtractSymbolsIntoColumns()

Dim rng As Range
Dim row_processed As Integer
Dim string_to_split As String
Dim columns_needed As Long
Dim counter As Long

row_processed = 1
 counter = 0
  Set rng = Range("Start_point")
    While rng.Offset(row_processed, 0).Value <> ""
      string_to_split = rng.Offset(row_processed, 0).Value
         columns_needed = TextSplitToNumbersAndOther(string_to_split)
          For counter = 1 To columns_needed
            rng.Offset(row_processed, counter).Value = _
              TextSplitToNumbersAndOther(string_to_split, counter)
          Next
         row_processed = row_processed + 1
      Wend
End Sub

Function TextSplitToNumbersAndOther(InputText As String, _
    Optional SplitPieceNumber As Long) As Variant

Dim piece_from_split(100)  As Variant
Dim char_from_input As String
Dim word_count As Long
Dim counter As Long
Dim char_type(100) As Variant

 InputText = Trim(InputText)

   If Not IsNull(InputText) Then
     word_count = 1
      piece_from_split(word_count) = ""
       For counter = 1 To Len(InputText)
         char_from_input = CharFromTextPosition(InputText, counter)
          char_type(counter) = CharTypeAsNumber(char_from_input)
            If counter = 1 Then
              piece_from_split(word_count) = char_from_input
            Else
              If (char_type(counter - 1) = char_type(counter)) Then
                 piece_from_split(word_count) = piece_from_split(word_count) & char_from_input
                   'Merge for the same type
              Else
                 word_count = word_count + 1
                   piece_from_split(word_count) = char_from_input


              End If
            End If
       Next
   End If

  If SplitPieceNumber = 0 Then
    TextSplitToNumbersAndOther = word_count
  Else
      If SplitPieceNumber > word_count Then
         TextSplitToNumbersAndOther = ""
      Else
        TextSplitToNumbersAndOther = piece_from_split(SplitPieceNumber)
      End If
  End If

End Function

Function CharTypeAsNumber(InputChar As String, Optional PositionInString As Long) As Long

   If PositionInString = 0 Then PositionInString = 1

     If Not IsNull(InputChar) Then
       InputChar = Mid(InputChar, PositionInString, 1)
        Select Case InputChar
          Case 0 To 9
            CharTypeAsNumber = 1
          Case "a" To "z"
            CharTypeAsNumber = 2
          Case "A" To "Z"
            CharTypeAsNumber = 3
          Case Else
            CharTypeAsNumber = 4
         End Select
     Else
           CharTypeAsNumber = 0

     End If

End Function
Function CharFromTextPosition(InputString As String, TextPosition As Long) As String

   CharFromTextPosition = Mid(InputString, TextPosition, 1)

End Function

Answer 3

您可以编写UDF（用户定义函数）来实现目标。您的两个示例按顺序（升序）过滤到Excel中的相邻列（A，B，C，D ...）

从逻辑上假设是正确的，你永远不会有必须将字符串分解为非相邻列的情况吗？例如1234进入A，＆amp;＆amp;转到C，3转到D ......产生A，C，D。

假设2：你的splitted-string不需要比Excel更多的列。

您可以尝试的步骤： 1.检查你的字符串是不是空的 2.用数字以外的字符拆分 3.在每个非数字字符的开头和结尾处，您可以前进到下一个相邻列。

搜索帮助：将字符串拆分为Excel中的多个列 - VBA

用于提取符号的VBA代码，如“＆amp;＆amp;”，“＆amp;＆amp; - ”，“＆amp; - ”和数字到不同的列

3 个答案: