帮助解决划线的问题

jqliuym

我的想法是：当在A列某一单元格内有“国家”字样时，就划一条B:S的粗实线。实例就看附件。谢谢！


                        划线.zip (6.22 KB, 下载次数: 2)

2018-9-7 20:07 上传

点击文件名下载附件

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   With Worksheets("sheet1")
   
5.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
6.     For i = r To 1 Step -1
   
7.       If InStr(.Cells(i, 1), "国家") <> 0 Then
   
8.         With .Cells(i, 2).Resize(1, 18)
   
9.           With .Borders(xlEdgeBottom)
   
10.             .LineStyle = xlContinuous
    
11.             .Color = -16776961
    
12.             .Weight = xlThick
    
13.           End With
    
14.         End With
    
15.       End If
    
16.     Next
    
17.   End With
    
18. End Sub
    

复制代码

chxw68

录制个宏稍微修改一下就行了。

jqliuym

chxw68 发表于 2018-9-7 20:14
录制个宏稍微修改一下就行了。

chxw68大师谢谢您的帮助。我另有一个问题需要您的鼎力相助。请看下面的附件。




按月份录入数据.zip (17.79 KB, 下载次数: 1)

2018-9-7 22:45 上传

点击文件名下载附件

chxw68

修改好了。

chxw68

1. Sub 保存()
   
2.   Dim arr, brr, I%, j%, nRow%
   
3.   Dim mon
   
4.   mon = Month(Sheets("录入").Range("g12"))
   
5.   arr = Sheets("录入").Range("g9:g27")
   
6.   For Each sh In Sheets
   
7.     If sh.Name Like "*月份" Then
   
8.         mm = Val(sh.Name)
   
9.         If mm = mon Then
   
10.             With sh
    
11.               nRow = .Range("a" & Rows.Count).End(3).Row + 1
    
12.               .Range("a" & nRow).Resize(1, UBound(arr)) = Application.WorksheetFunction.Transpose(arr)
    
13.             End With
    
14.         End If
    
15.     End If
    
16.   Next
    
17. 
    
18. End Sub
    
19. 
    

复制代码