宏將TRANSPOSE逗號分隔的單元格劃分成行並向下複製相鄰單元格

Question

我有一個電子表格，其中有需要分割的輸入數據行。

目前，這是一個手動過程，我提供了一個鏈接到工作簿時，我已分割我已被做成工作表中的步驟：

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

當手工完成的邏輯過程是，首先按列E（Temp）和F（Location）拆分，因爲它們直接鏈接到彼此，然後在下面插入一個空白行，以使它們按工作表步驟1中所示分開。

然後下一步是拆分列B從範圍A：Y中取樣並複製從上面的行到達結束r esult。

解決這個問題的最佳方法是使用鍵盤快捷鍵使其更快，但如果可以將它放入宏中，每週可以節省數小時！

問候。

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