将逗号分隔的单元格转置为行并复制相邻单元格的宏答案

【问题标题】：Macro to TRANSPOSE comma delimited cell into rows and copy down adjacent cells将逗号分隔的单元格转置为行并复制相邻单元格的宏
【发布时间】：2015-09-12 08:32:51
【问题描述】：

我有一个电子表格，其中输入了需要拆分的数据行。

目前这是一个手动过程，当我将正在执行的步骤拆分为工作表时，我提供了指向工作簿的链接：

https://www.dropbox.com/s/0p3fg94pa61e4su/Example.xlsx?dl=0

当手动完成时，逻辑过程是首先按列 E（Temp）和 F（Location）拆分，因为它们直接相互关联，然后在下面插入一个空白行，以便将它们分开，如工作表步骤 1 所示。

然后下一步是按列 B Samples 进行拆分，并在 A:Y 范围内从上方向下复制行以达到最终结果。

解决此问题的最佳方法是什么，因为我使用键盘快捷键使其更快，但如果可以将其放入宏中，每周将节省数小时！

问候。

【问题讨论】：

标签： excel comma transpose delimited

【解决方案1】：

我相信以下内容应该适合您。

Sub strata_data()
    Dim t As Long, s As Long, rw As Long
    Dim vTEMPs As Variant, vSAMPLEs As Variant, vOVENs As Variant

    Application.ScreenUpdating = False

    With Worksheets("Start2") '<~~set this worksheet name correctly
        For rw = .Cells(Rows.Count, 1).End(xlUp).Row To 6 Step -1
            vSAMPLEs = Split(.Cells(rw, 2).Value2, Chr(44))
            vTEMPs = Split(.Cells(rw, 5).Value2, Chr(44))
            vOVENs = Split(.Cells(rw, 6).Value2, Chr(44))
            For t = UBound(vTEMPs) To LBound(vTEMPs) Step -1
                .Cells(rw + 1, 1).Resize(2 + (t = LBound(vTEMPs)), 1).EntireRow.Insert
                .Cells(rw, 1).Resize(1, 7).Copy Destination:=.Cells(rw + 1 + (t = LBound(vTEMPs)), 1)
                .Cells(rw + 1 + (t = LBound(vTEMPs)), 5) = CLng(vTEMPs(t))
                .Cells(rw + 1 + (t = LBound(vTEMPs)), 6) = vOVENs(t)
                .Cells(rw + 1 + (t = LBound(vTEMPs)), 5).NumberFormat = "0° \C"
                .Cells(rw + 2 + (t = LBound(vTEMPs)), 1).Resize(1, 25).ClearContents
                .Cells(rw + 2 + (t = LBound(vTEMPs)), 1).Resize(1, 25).Interior.Pattern = xlNone
                If CBool(UBound(vSAMPLEs)) Then
                    .Cells(rw + 1 + (t = LBound(vTEMPs)), 1).Resize(1, 25).Copy
                    .Cells(rw + 1 + (t = LBound(vTEMPs)), 1).Resize(UBound(vSAMPLEs), 25).Insert Shift:=xlDown
                    For s = UBound(vSAMPLEs) To LBound(vSAMPLEs) Step -1
                        .Cells(rw + 1 + s + (t = LBound(vTEMPs)), 2) = vSAMPLEs(s)
                    Next s
                End If
            Next t
        Next rw
    End With

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

在 G 列右侧的列中有一些。我不知道它们是否是种子数据，所以我不理会它们。如果没有必要，您应该可以使用简单的.ClearContents 命令清除它们。

【讨论】：

您好，我已重命名工作表，但收到错误提示下标超出范围？谢谢
我的立场是正确的！代码确实有效，我没有正确命名它！它几乎是完美的，但是，我没有很好地解释，这会在每个样本之后插入一行，而我只需要在每个样本块中插入一行。所以A,B,C,D,空行,A,B,C,D,空行！非常感谢！
开始前有一个我没看到的空格，问题解决了！
我知道这开始起来非常复杂，但在其他问题中你已经证明了最初的努力。作为programming enthusuast，我认为您会欢迎有机会纠正自己的错误。如果您在调整上述代码时遇到问题，也许您可以不理会它并编写一个简短的子例程来删除您在完成后留在示例中的额外行。