Excel VBA 셀이 첫 번째 문자와 일치하는 경우 행 삽입

Question

첫 번째 열의 정보가 특정 수준과 일치하는지 여부에 따라 행을 결합하려는 위치가 큰 데이터 세트가 있습니다. 내가 할 수있는 매크로가 있는지 궁금 해서요. 아래에는 비슷한 단순화 된 데이터 세트의 이미지가 포함되어 있습니다. 매크로를 새 워크 시트에 새 테이블을 만들거나 기존 데이터 아래에 행을 삽입 할 것이라고 가정하지만 확실하지 않습니다. 이 문제에 대한 도움이나 조언은 매우 유용합니다.

샘플 데이터 세트 :

출력 :

Answer 1

다음 (주석) 코드를 시도 할 수 있습니다 :

Option Explicit 

Sub main() 
    Dim cell As Range, cell2 As Range 

    With Worksheets("experiment").Range("A1").CurrentRegion '<--| reference data worksheet(change "experiment" to its actual name) cell "A1" contiguous range column "A" 
     .Sort key1:=Range("A1"), order1:=xlAscending, Header:=xlYes '<--| sort it by "experiment" column to have "smaller" names at the top 
     For Each cell In .Offset(1).Resize(.Rows.Count - 1, 1) '<--| loop through its 1st column cells skipping header row 
      If cell.Value <> "" Then '<--| if current cell isn't blank (also as a result of subsequent operations) 
       .AutoFilter Field:=1, Criteria1:="*" & cell.Value & "*" '<--| filter on referenced column to get cell "containing" current cell content 
       If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 2 Then '<--| if more than 2 rows has been foun: header row gets always filtered so to have at least 2 rows to consolidate we must filter at least 3 
        With .Offset(1).Resize(.Rows.Count - 1) '<--| reference filtered rows skipping header row 
         For Each cell2 In .Offset(, 1).Resize(, .Columns.Count - 1).SpecialCells(xlCellTypeVisible).Areas(1).Rows(1).Cells '<--| loop through 1st filtered row cells skipping 1st column ("experiment") 
          cell2.Value = WorksheetFunction.Subtotal(9, cell2.EntireColumn) '<--| update their content to the sum of filtered cells in corresponding column 
         Next cell2 
         With .Resize(, 1).SpecialCells(xlCellTypeVisible) '<--| reference filtered rows 1st column ("experiment") cells 
          .Value = .Cells(1, 1) '<--| have them share the same name 
         End With 
         .RemoveDuplicates Columns:=Array(1), Header:=xlNo '<--| remove duplicates, thus leaving the 1st filtered row with totals 
        End With 
       End If 
      End If 
     Next cell 
     .Parent.AutoFilterMode = False '<--| show all rows back 
    End With 
End Sub 

Answer 2

는 첫 번째 열의 처음 몇 문자를 추출하는 열을 추가합니다. 그런 다음 행에 새 열이 있고 값 영역에 다른 열이있는 피벗 테이블을 만듭니다. VBA는 필요하지 않습니다.