拆分单元格并推送到可以使用空白单元格的行

Question

我有一个 Excel 文件，其中存储了 session 对客户的描述，每个 session 一行。在一个专栏中，我有一个 comma-separated 列表，其中包含 session 期间发生的所有活动。我一直在使用以下代码，它可以很好地用逗号分隔 activity 列表，将每个 activity 推到另一个 sheet 中的新行，并从中获取所有其他信息行：

Sub SplitFoci()
    Dim Temp As Variant
    Dim CText As String
    Dim J As Integer
    Dim K As Integer
    Dim L As Integer
    Dim iColumn As Integer
    Dim lNumCols As Long
    Dim lNumRows As Long

    Set wksSource = Worksheets("OutputWorkingCopy1")
    Set wksOutput = Worksheets("OutputSplitFoci")

    iColumn = 9
    iTargetRow = 0
    With wksSource
        lNumCols = .Range("IV1").End(xlToLeft).column
        lNumRows = .Range("A65536").End(xlUp).Row
        For J = 3 To lNumRows
            CText = .Cells(J, iColumn).Value
            Temp = Split(CText, ",")
            For K = 0 To UBound(Temp)
                iTargetRow = iTargetRow + 1
                For L = 1 To 40
                    If L <> iColumn Then
                        wksOutput.Cells(iTargetRow, L) _
                          = .Cells(J, L)
                    Else
                        wksOutput.Cells(iTargetRow, L) _
                          = Temp(K)
                    End If
                Next L
            Next K
        Next J
    End With

End Sub

不幸的是，如果它到达 activity 列中有空白单元格的行（即没有任何活动的管理任务），它会停止遍历列表，既不会推送管理 session 信息或随后的任何客户 session。有谁知道如何编辑此代码以使其推送所有信息而不会停止？

Answer 1

如果 .Cells(J, iColumn).Value 有用逗号分隔的活动，代码会很好地工作，因为它被拆分并且拆分的值被枚举通过。

如果 .Cells(J, iColumn).Value 有单个 activity（无逗号），代码有效，因为 Split 导致单个 activity 条目；例如LBound(Temp) 和 UBound(Temp) 都为零，因此只有一次通过 For ... Next 循环。

如果 .Cells(J, iColumn).Value 是一个空白单元格（例如 IsEmpty(.Cells(J, iColumn) = True），代码将停止工作，因为 Split 导致 LBound(Temp) 为零和 UBound(Temp) 的 -1 和 For ... Next 循环甚至没有通过一次。

一种方法是在 UBound(Temp) < LBound(Temp) 的情况下用占位符填充 Temp，例如

    CText = .Cells(J, iColumn).Value
    Temp = Split(CText, ",")
    if ubound(Temp) < lbound(Temp) then Temp = Split("<non-activity>", ",")

这与只有一个 activity 一样。另一种方法是确保至少运行通过 For ... Next 循环并在时机成熟时弥补缺少 Temp 的情况。

    For K = 0 To (UBound(Temp) - CBool(UBound(Temp) < LBound(Temp))) 'from 0 to 0 when UBound(Temp) < LBound(Temp)
        iTargetRow = iTargetRow + 1
        For L = 1 To 40
            If L <> iColumn Then
                wksOutput.Cells(iTargetRow, L) _
                  = .Cells(J, L)
            ElseIf Not CBool(UBound(Temp) < LBound(Temp)) Then
                wksOutput.Cells(iTargetRow, L) _
                  = Temp(K)
            End If
        Next L
    Next K

至少通过所有列一次。当没有 activity.

时，将完全跳过第 9 列

最后两个代码片段之一应该可以修复您的循环。选择您认为最有意义的一项。

拆分单元格并推送到可以使用空白单元格的行

Split Cells and Push to Rows That Can Work with Blank Cells

excel

vba

for-loop

with-statement

csv