将逗号分隔的单元格转换为行并向下复制相邻单元格的宏

Macro to TRANSPOSE comma delimited cell into rows and copy down adjacent cells

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

目前这是一个手动过程,当我将正在执行的步骤拆分到工作表中时,我已经向工作簿提供了一个 link:

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

当手动完成时,逻辑过程是首先按列 E(温度)和 F(位置)拆分,因为它们直接 linked 到彼此,然后在下面插入一个空白行,以便将它们分开显示在工作表步骤 1 中。

然后下一步就是按B列Samples拆分,从上面复制行在A:Y范围内,得到最终结果。

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

此致。

我相信以下内容对您有用。

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 命令清除它们。