宏到TRANSPOSE逗号分隔的单元格成行并向下复制相邻的单元格 [英] Macro to TRANSPOSE comma delimited cell into rows and copy down adjacent cells

问题描述

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

I have a spreadsheet in which there are rows of data entered which need to be split.

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

Currently this is a manual process, I have provided a link to the workbook when i have split the steps I have being doing into worksheets:

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

手动完成后，逻辑过程是首先按列E（临时）和F（位置），因为它们直接彼此链接，然后在下面插入空白行，以便将它们分开，如工作表中的步骤1所示。

When done manually the logical process is to first split by column E (Temp) and F (Location) as these are directly linked to eachother, then insert a blank row underneath so they are separated as shown in the worksheet step 1.

然后下一步是拆分按列B的示例，并从A：Y范围的上方向下复制行以达到最终结果。

Then the next step is to split by column B Samples and copy the rows down from above in the range A:Y to reach the end result.

使用键盘快捷键可以使其更快，但如果可以将其放入宏中，则可以每周节省数小时！

What is the best way to approach this as I am to use keyboard shortcuts to make it quicker but if it is possible to put this into a macro would save literally hours a week!

问候。

推荐答案

我相信以下内容应该为您工作。

I believe the following should work for you.

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

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

There were some ones in column to the right of column G. I didn't know if they were seeded data so I left them alone. You should be able to clear them out with a simple .ClearContents command if they are unnecessary.

这篇关于宏到TRANSPOSE逗号分隔的单元格成行并向下复制相邻的单元格的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！