VBA для сокращения указанного c диапазона ячеек на основе другой ячейки - PullRequest
Новая
       52

VBA для сокращения указанного c диапазона ячеек на основе другой ячейки

0 голосов
/ 12 февраля 2020

Надеюсь, что какой-нибудь эксперт VBA сможет мне помочь!

Мне нужно определить строки данных, которые содержат повторяющиеся значения в столбце H, а затем вырезать данные из ячеек N: S первой повторяющейся строки. и вставьте его в конец первой строки, в первую пустую ячейку

Я попытаюсь объяснить это лучше ...

Столбцы A: G можно игнорировать. Столбец H содержит дубликаты числа. Если найдены дубликаты, мне нужно вырезать данные в столбце N3: S3 первого дубликата (строка 3, h3 в примере) и добавить его в конец существующих столбцов как новые столбцы.

Прикрепленное изображение показывает текущее состояние данных, в строках 1: 3 и строках 8: 9 показано, как они должны выглядеть в итоге.

enter image description here

Я надеюсь, что кто-то может интерпретировать это и помочь мне !!

Спасибо

Мне удалось запустить следующий VBA, записав макрос, примерно отражающий то, на что я надеюсь достигать. Основная проблема заключается в том, что там, где я вручную скопировал строки 1: 3, идентифицировал их как код для распознавания дубликатов (сгруппировав их вместе как таковой) и затем выбрав соответствующие данные: 

' Macro1 Macro

    Sheets("Report").Select
    Columns("H:H").Select
    Selection.FormatConditions.AddUniqueValues
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).DupeUnique = xlDuplicate
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("H1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$S$17").AutoFilter Field:=8, Criteria1:=RGB(255, _
        199, 206), Operator:=xlFilterCellColor
    Rows("1:3").Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
    Sheets("Sheet10").Select
    Range("N3:S3").Select
    Application.CutCopyMode = False
    Selection.Cut Destination:=Range("T2:Y2")
    Range("T2:Y2").Select

    Rows("3:3").Select
    Selection.Delete Shift:=xlUp
End Sub
...