2012-10-29 13 views
22

Próbuję utworzyć prostą funkcję, która doda obramowania wokół każdej komórki w pewnym zakresie. Używanie wspaniałego nagrania generuje tonę kodu, który jest zupełnie bezużyteczny. Poniższy kod wyświetli "tabelę" danych, wokół każdej komórki w tym zakresie chciałbym dodać granicę. W Internecie nie udało mi się znaleźć prostej lub jasnej odpowiedzi.Obramowanie wokół każdej komórki w zakresie

Cała pomoc jest doceniana!

Set DT = Sheets("DATA") 
endRow = DT.Range("F" & Rows.Count).End(xlUp).Row 
result = 3 

For I = 2 To endRow 
    If DT.Cells(I, 6).Value = Range("B1").Value Then 
     Range("A" & result) = DT.Cells(I, 6).Value 
     Range("B" & result) = DT.Cells(I, 1).Value 
     Range("C" & result) = DT.Cells(I, 24).Value 
     Range("D" & result) = DT.Cells(I, 37).Value 
     Range("E" & result) = DT.Cells(I, 3).Value 
     Range("F" & result) = DT.Cells(I, 15).Value 
     Range("G" & result) = DT.Cells(I, 12).Value 
     Range("H" & result) = DT.Cells(I, 40).Value 
     Range("I" & result) = DT.Cells(I, 23).Value 
     result = result + 1 
    End If 
Next I 
+1

edytowany mój tytuł widział jakby mylić ludzi. – CustomX

Odpowiedz

77

Trzeba tylko jednej linii kodu ustaw granicę wokół każdej komórki w zakresie:

Łatwo zastosować wiele efektów do obramowania wokół każdej komórki.

Na przykład:

Sub RedOutlineCells() 
    Dim rng As Range 

    Set rng = Range("A1:F20") 

    With rng.Borders 
     .LineStyle = xlContinuous 
     .Color = vbRed 
     .Weight = xlThin 
    End With 
End Sub 
1

Aby dodać granice spróbować, na przykład:

Range("C11").Borders(xlEdgeRight).LineStyle = xlContinuous 
Range("A15:D15").Borders(xlEdgeBottom).LineStyle = xlContinuous 

nadzieję, że składnia jest poprawna, ponieważ robiłem to w języku C#.

+0

Naprawdę nie pomaga, to zadziała na zakresie, ale nie na komórkę. – CustomX

+0

i co to dokładnie jest: Zakres ("C11") Granice (xlEdgeRight) .LineStyle = xlContinuous lub to: Zakres ("A15: A15") .Borders (xlEdgeBottom) .LineStyle = xlContinuous – Sylca

+0

Idk to to, co " ve nie stworzyłem niczego podanego w moim początkowym kodzie. – CustomX

8

Poniższa można wywołać z dowolnego zakresu jako parametru:

Option Explicit 

Sub SetRangeBorder(poRng As Range) 
    If Not poRng Is Nothing Then 
     poRng.Borders(xlDiagonalDown).LineStyle = xlNone 
     poRng.Borders(xlDiagonalUp).LineStyle = xlNone 
     poRng.Borders(xlEdgeLeft).LineStyle = xlContinuous 
     poRng.Borders(xlEdgeTop).LineStyle = xlContinuous 
     poRng.Borders(xlEdgeBottom).LineStyle = xlContinuous 
     poRng.Borders(xlEdgeRight).LineStyle = xlContinuous 
     poRng.Borders(xlInsideVertical).LineStyle = xlContinuous 
     poRng.Borders(xlInsideHorizontal).LineStyle = xlContinuous 
    End If 
End Sub 

Przykłady:

Call SetRangeBorder(Range("C11")) 
Call SetRangeBorder(Range("A" & result)) 
Call SetRangeBorder(DT.Cells(I, 6)) 
Call SetRangeBorder(Range("A3:I" & endRow)) 
5

Oto kolejny sposób

Sub testborder() 

    Dim rRng As Range 

    Set rRng = Sheet1.Range("B2:D5") 

    'Clear existing 
    rRng.Borders.LineStyle = xlNone 

    'Apply new borders 
    rRng.BorderAround xlContinuous 
    rRng.Borders(xlInsideHorizontal).LineStyle = xlContinuous 
    rRng.Borders(xlInsideVertical).LineStyle = xlContinuous 

End Sub 
2

Nie znalazłeś tę stronę, kiedy został pierwotnie patrząc na ten problem, ale tutaj był mój wynik końcowy. Uczciwie spojrzał i zamieścił w SuperUsers, ale nie jest pewien, czy należy tam lub tutaj.

Próbka połączeń

Call BoxIt(Range("A1:z25")) 

Subroutine

Sub BoxIt(aRng As Range) 
On Error Resume Next 

    With aRng 

     'Clear existing 
     .Borders.LineStyle = xlNone 

     'Apply new borders 
     .BorderAround xlContinuous, xlThick, 0 
     With .Borders(xlInsideVertical) 
      .LineStyle = xlContinuous 
      .ColorIndex = 0 
      .Weight = xlMedium 
     End With 
     With .Borders(xlInsideHorizontal) 
      .LineStyle = xlContinuous 
      .ColorIndex = 0 
      .Weight = xlMedium 
     End With 
    End With 

End Sub 
0
xlWorkSheet.Cells(1, 1).Borders(Excel.XlBordersIndex.xlEdgeRight).LineStyle = Excel.XlDataBarBorderType.xlDataBarBorderSolid 
xlWorkSheet.Cells(1, 1).Borders(Excel.XlBordersIndex.xlEdgeLeft).LineStyle = Excel.XlDataBarBorderType.xlDataBarBorderSolid 
xlWorkSheet.Cells(1, 1).Borders(Excel.XlBordersIndex.xlEdgeBottom).LineStyle = Excel.XlDataBarBorderType.xlDataBarBorderSolid 
xlWorkSheet.Cells(1, 1).Borders(Excel.XlBordersIndex.xlEdgeTop).LineStyle = Excel.XlDataBarBorderType.xlDataBarBorderSolid 
Powiązane problemy