엑셀 VBA 나는 아래의 코드를

Question

열 이름과 셀 값을 기준으로 그룹에 테두리를 할당하는 나는 다음을 수행 할 :

이

는 이름 (예 : "회사")에 따라 특정 컬럼을 통해 이동 해당 열 (예 : "CompanyA", "CompanyB", "CompanyC"등)의 값을 기준으로 테두리를 두꺼운 상자 테두리로 변경합니다. 이것은 "회사 A"(50 줄)는 경계선을 가져오고 "B 회사"(5 줄)는 경계선을 얻는 것을 의미합니다.

이 작업을 수행 할 수 있습니까? 미리 타이!

Sub DrawBorders() 

Dim rCell As Range 
Dim rRange As Range 

Set rRange = Range("A1", Range("A65536").End(xlUp)) 

For Each rCell In rRange 
    If Not IsEmpty(rCell) And _ 
    Not IsEmpty(rCell.Offset(1, 0)) Then 
     With rCell 
      If .Value <> .Offset(1, 0).Value Then 
       With .EntireRow.Borders(xlEdgeBottom) 
        .LineStyle = xlContinuous 
        .Weight = xlMedium 
        .ColorIndex = xlAutomatic 
       End With 
      End If 
     End With 
    End If 
Next rCell 

End Sub 

Answer 1

귀하의 요청에 맞게 코드를 조정했습니다. 이렇게하면 원하는 회사 유형에만 테두리가 생깁니다. 처리중인 데이터에 따라 IF 문에 오류 catching을 추가해야 할 수도 있습니다.

Sub DrawBoarders() 
    Dim rCell As Range 
    Dim rRange As Range 
    Dim Prev As String 
    Dim MyCell As String 
    Prev = "" 

    Set rRange = Range("A2", Range("A65536").End(xlUp)) 
    Dim SpecificCompany(3) As String 'Using 3 companies (Company A, B, & C) 
    'Array of desired company names 
    SpecificCompany(0) = "CompanyA" 
    SpecificCompany(1) = "CompanyB" 
    SpecificCompany(2) = "CompanyC" 


    If IsInArray(Range("A1"), SpecificCompany) Then 'Check 1st row 
      With Range("A1").EntireRow.Borders(xlEdgeTop) 
       .LineStyle = xlContinuous 
       .Weight = xlMedium 
       .ColorIndex = xlAutomatic 
      End With 
    End If 

    For Each rCell In rRange 
     If IsInArray(rCell.Value, SpecificCompany) And rCell.Value <> rCell.Offset(-1, 0).Value Then 
      With rCell.EntireRow.Borders(xlEdgeTop) 
       .LineStyle = xlContinuous 
       .Weight = xlMedium 
       .ColorIndex = xlAutomatic 
      End With 
     End If 
     If Not IsEmpty(rCell) And _ 
     Not IsEmpty(rCell.Offset(1, 0)) Then 
     If rCell.Value <> rCell.Offset(1, 0).Value Then 
      With rCell.EntireRow.Borders(xlEdgeBottom) 
       .LineStyle = xlContinuous 
       .Weight = xlMedium 
       .ColorIndex = xlAutomatic 
      End With 
     End If 
     End If 
    Next rCell 
End Sub 

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean 
    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1) 
End Function