Question

交易表

 ID1  Name Amount ID2 
 123   A     1   0;124;0 
 456   B     2   124;0;0  
 789   C     3   456;0;0

交易表（预期结果）

 ID1  Name Amount ID2   Summary
 123   A     1   0;124;0  124
 456   B     2   124;0;0  456
 789   C     3   456;0;0

我已尝试将文字添加到列中，但我不确定如何忽略所有0，并且只显示值，如果列D中的＆gt; 0.我是vba的新手，所以会对此有所建议所以我可以学习。

代码：

  Sub SplitRange()
  Dim cell As Range
  Dim str As Variant    'string array
  Dim r   As Integer
  For Each cel In ActiveSheet.UsedRange
   If InStr(cell.Value, ";") > 0 Then 'split
   str = Split(cell.Value, ";")
   For r = LBound(str) To UBound(str)
   cel.Offset(r).Value = Trim(str(r))
   If r < UBound(str) Then cell.Offset(r + 1).EntireRow.Insert
   Next r
   End If
  Next cell 
  End Sub

Answer 1

首先，我们不应该遍历所有使用过的单元格，而只需要遍历我们需要的这些ID2的行，这样会快得多。

最简单的方法就是删除所有;0和0;，然后只保留值。如果始终只有一个不是0的实际值，例如0;124;0，则以下内容将起作用。

Public Sub FindValueRangeInColumn()
    Const Col As Long = 4   'the column where the ID2 is in

    Dim ws As Worksheet
    Set ws = ThisWorkbook.ActiveSheet

    Dim lRow As Long
    lRow = ws.Cells(ws.Rows.Count, Col).End(xlUp).Row 'find last used row in column

    Dim iRow As Long
    For iRow = 2 To lRow 'loop throug rows from 2 to last used row
        Dim strSource As String
        strSource = ws.Cells(iRow, Col) 'read value

        strSource = Replace(ws.Cells(iRow, Col), ";0", "") 'remove all ;0
        If Left$(strSource, 2) = "0;" Then strSource = Right$(strSource, Len(strSource) - 2) 'remove 0; from the beginnning

        ws.Cells(iRow, Col + 1).Value = strSource 'write value
    Next iRow
End Sub

如果可以有超过1个非零值，例如0;124;0;222;0;0;144，则替换

ws.Cells(iRow, Col + 1).Value = strSource 'write value

分裂替代......

    If InStr(1, strSource, ";") > 1 Then
        Dim SplitValues As Variant
        SplitValues = Split(strSource, ";")
        Dim iValue As Long
        For iValue = LBound(SplitValues) To UBound(SplitValues)
            ws.Cells(iRow, Col + 1 + iValue).Value = SplitValues(iValue) 'write value
        Next iValue
    Else
        ws.Cells(iRow, Col + 1).Value = strSource 'write value
    End If

Answer 2

那么，你想将非0值连接成一个字符串，然后把它放在下一个单元格中？

Sub SplitRange()
    Dim workcell As Range
    Dim str() As String 'string array
    Dim r As Long 'VBA automatically stores Integers as Longs, so there is no Memory saved by not using Long
    Dim output As String
    output = ";" 'Start with a single delimiter

    For Each workcell In Intersect(ActiveSheet.UsedRange,ActiveSheet.Columns(4)) 'Go down the cells in Column D
        If InStr(workcell.Value, ";") > 0 Then 'split
            str = Split(workcell.Value,";")
            For r = LBound(str) To UBound(str)
                If inStr(output, ";" & Trim(str(r)) & ";") < 1 Then 'If number is not already in output
                    output = output & Trim(str(r)) & ";" 'Add the number and ";" to the end of the string
                End If
            Next r
            Erase str 'Tidy up array, ready to recycle
        End If
    Next workcell
    'We now have a unique list of all items, starting/ending/delimited with ";"
    output = Replace(output,";0;",";") 'Remove the item ";0;" if it exists
    If Len(output) > 2 Then 'output contains at least 1 non-zero number
        output= Mid(output,2,len(output)-2) 'Remove ";" from the start and end
        str = Split(output,";") 'Split the list of unique values into an array
        For r = lbound(str) To ubound(str)
            ActiveSheet.Cells(r+2-lbound(str),5).Value = str(r) 'List the values in column 5, starting from row 2
        Next r
        Erase str 'Tidy up array
    End If
End Sub

要从单行中删除＆＃34; 0＆＃34;作为Excel公式，请尝试以下操作：

=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE("|;" & A1 & ";|", ";0;",";"),";|",""),"|;","")

由内而外：

SUBSTITUTE("|;" & A1 & ";|", ";0;",";")将我们的值夹在包装器（"|;0;240;0;|"）中并替换任何＆＃34 ;; 0;＆＃34;用＆＃34;;＆＃34; （"|;240;|"）

SUBSTITUTE(PREV,";|","")删除＆＃34 ;; |＆＃34; （"|;240"）

SUBSTITUTE(PREV,"|;","")删除＆＃34; |;＆＃34; （"240"）

Answer 3

上午，

这里需要的是将条目拆分为数组，然后在循环数组时检查数组的值：

Sub SplitString()

Dim TempArray() As String
Dim i as Integer
Dim j As Integer


For i = 1 To 10

    TempArray = Split(Worksheets("Sheet1").Cells(i,4).Value,";")

    For j = 0 to UBound(TempArray)

        If CDbl(TempArray(j)) <> 0 Then

              [Output value]

        End if

    Next j

Next i

End Sub

创建一个比1 = 1到10更有用的循环，但你明白了......

以上注意事项： - CDbl是为了确保检查将其读作数字而不是文本字符串。

拆分已分隔的值

3 个答案: