如何根据原始表中关键列班级和姓名2列加表格线外边框双线

yzyyyyyyy

原始表：班级和姓名列，若两列邻近相同，数据加表格线，边框加双线 如何根据原始表中关键列班级和姓名2列加表格线外边框双线.rar (2.19 KB, 下载次数: 4)

2024-8-15 16:04 上传

点击文件名下载附件

ykcbf1100

加双线框。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.8.15
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     Set ws = ActiveSheet
   
4.     r = ws.Cells(Rows.Count, 1).End(3).Row
   
5.     arr = [a1].Resize(r, 6)
   
6.     For i = 2 To UBound(arr)
   
7.         s = arr(i, 3) & "|" & arr(i, 6)
   
8.         If Not d.exists(s) Then
   
9.             d(s) = Array(i, i)
   
10.         Else
    
11.             t = d(s)
    
12.             t(1) = i
    
13.             d(s) = t
    
14.         End If
    
15.     Next
    
16.     ws.Cells(2, 1).Resize(r - 1, 6).Borders(xlEdgeTop).LineStyle = xlContinuous
    
17.     For Each k In d.keys
    
18.         r1 = d(k)(0): r2 = d(k)(1)
    
19.         ws.Cells(r1, 1).Resize(, 6).Borders(xlEdgeTop).LineStyle = xlDouble
    
20.         ws.Cells(r2, 1).Resize(, 6).Borders(xlEdgeBottom).LineStyle = xlDouble
    
21.     Next
    
22.     MsgBox "OK！"
    
23. End Sub
    

复制代码

gwjkkkkk

Option Explicit
Sub test1()
    Dim ar, i&, p&
   
    With [A1].CurrentRegion.Offset(1)
        ar = .Resize(.Rows.Count + 1)
        .Cells(1, 1).Resize(, UBound(ar, 2)).Borders(xlEdgeTop).LineStyle = xlDouble
        p = 1
        For i = 1 To UBound(ar) - 1
            If ar(i + 1, 3) <> ar(p, 3) Then
                .Cells(i, 1).Resize(, UBound(ar, 2)).Borders(xlEdgeBottom).LineStyle = xlDouble
                p = i + 1
            End If
        Next i
    End With
End Sub

gwjkkkkk

参与一下。。。

chxw68

练习。。。