일치 조건을 기반으로 행 제거

Question

VB의 기본 사항을 이해할 수 있도록 날짜가 기입되어 있지만 매크로를 자주 작성하지 않고 특정 조건을 해결하는 데 도움이 필요합니다. (...하지만 함수와 객체 지향 프로그래밍을 이해합니다.)

다음과 같이 가정하십시오. - 열 A는 영숫자 형식의 참조 ID를 알파벳순으로 정렬합니다. - B 열에는 텍스트 문자열 또는 공백이 들어 있습니다.

열 B의 "메모"내용을 기반으로 각 고유 참조 번호에 대한 추가 행을 자동으로 제거하는 매크로를 작성하려고합니다. 문제는 열 A에 고유 한 ref 어떤 행에 B 열에 무엇인가가 들어 있는지 확인해야합니다. 하나의 catch가 있습니다. 참조 번호가 B 열에 아무 것도없고 유지되어야 할 수도 있습니다. 노란색이 나는 방법의 다양한 구성을 보여 주려고 나머지 행

삭제 행을

을 강조 유지

• :

  는 더 설명하기 위해 다음 스크린 샷에 내가해야 보고서는 오른쪽에 괄호를 사용하고 빨간색으로 표시하여 데이터를 표시 할 수 있습니다. 그 일을 설명하기가 어렵 기 때문에 그림이 더 명확하게 필요하다는 것을 알았습니다.

  

  이 작업은 보고서가 매우 매뉴얼 제작하고 시간이 많이 소요.

Answer 1

매우 간단합니다. 행을 삭제하고이 행을 삭제해야하는지 확인하십시오.이 ID가있는 이전 행을 삭제해야하거나 아무 것도 일어나지 않아야합니다. 내 예제에서는 이러한 행을 표시하고 결국 삭제합니다.

Sub foo() 
Dim rngSelection As Range 
Dim startingRow As Integer 
Dim endRow As Integer 
Dim idColumn As Integer 
Dim noteColumn As Integer 
Dim idValuableRow As New Dictionary 
Dim deleteRows As New Collection 

Set rngSelection = Selection 
startingRow = rngSelection.Row 
endRow = rngSelection.Rows.Count + startingRow - 1 


idColumn = rngSelection.Column 
noteColumn = idColumn + 1 

For i = startingRow To endRow 
    currentID = Cells(i, idColumn) 
    If idValuableRow.Exists(currentID) Then 
     If Trim(idValuableRow(currentID)("note")) <> "" And Trim(Cells(i, noteColumn)) = "" Then 
      deleteRows.Add i 
     ElseIf idValuableRow(currentID)("note") = "" And Trim(Cells(i, noteColumn)) <> "" Then 
      deleteRows.Add idValuableRow(currentID)("row") 
      idValuableRow(currentID)("row") = i 
      idValuableRow(currentID)("note") = Cells(i, noteColumn) 
     End If 
    Else 
     Dim arr(2) As Variant 
     idValuableRow.Add currentID, New Dictionary 
     idValuableRow(currentID).Add "row", i 
     idValuableRow(currentID).Add "note", Cells(i, noteColumn) 
    End If 


Next i 
deletedRows = 0 
For Each element In deleteRows 
    If element <> "" Then 
     Rows(element - deletedRows & ":" & element - deletedRows).Select 
     Selection.Delete Shift:=xlUp 
     deletedRows = deletedRows + 1 

     End If 
    Next element 

End Sub 

이렇게 보일 수 있습니다. 필요한 도구/참조에 Microsoft Scripting Runtime을 추가하는 것입니다.