Макрос для ТРАНСПОЗИРОВКИ ячейки с разделителями-запятыми в строки и копирования соседних ячеек

У меня есть электронная таблица, в которой есть строки введенных данных, которые необходимо разделить.

В настоящее время это ручной процесс, я предоставил ссылку на книгу, когда я разделил шаги, которые я выполняю, на рабочие листы:

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

При выполнении вручную логический процесс состоит в том, чтобы сначала разделить столбцы E (Temp) и F (Location), поскольку они напрямую связаны друг с другом, а затем вставить пустую строку под ними, чтобы они были разделены, как показано на шаге 1 рабочего листа.

Затем следующим шагом является разделение по столбцу B Samples и копирование строк сверху вниз в диапазоне A: Y для достижения конечного результата.

Как лучше всего подойти к этому, поскольку я должен использовать сочетания клавиш, чтобы сделать это быстрее, но если это возможно поместить в макрос, это сэкономит буквально часы в неделю!

С Уважением.


excel transpose comma delimited
person vividillusion    schedule 12.09.2015    source источник

Ответы (1)


arrow_upward
1
arrow_downward

Я считаю, что следующее должно работать для вас.

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, если они не нужны.

person Community    schedule 12.09.2015
comment
Привет, я переименовал лист, но получаю сообщение об ошибке: нижний индекс вне допустимого диапазона? Спасибо - person vividillusion; 12.09.2015
comment
Я исправляюсь! Код работает, я его не правильно назвал! Это почти идеально, однако я не очень хорошо объяснил, это вставляет строку после каждого сэмпла, тогда как мне нужно вставить только одну строку на блок сэмплов. Итак, A, B, C, D, пустая строка, A, B, C, D, пустая строка! Огромное спасибо! - person vividillusion; 12.09.2015
comment
У меня было место перед стартом, которого я не видел, проблема решена! - person vividillusion; 12.09.2015
comment
Я понимаю, что это было довольно сложно, чтобы начать, но в других вопросах вы продемонстрировали оригинальные усилия. Как энтузиаст программирования, я думаю, что вы будете рады возможности исправить свои собственные ошибки. Если у вас возникли проблемы с настройкой приведенного выше кода, возможно, вы могли бы оставить его в покое и написать короткую подпрограмму для удаления лишних строк, которые вы оставили в образце после его завершения. - person ; 12.09.2015