excel - 根据范围内 2 个单元格的值添加单元格边框
问题描述
我正在寻找一个漂亮的报告以进行破坏。A列中有日期,C列中有首字母。如果一组行的日期相同,例如01/01/1901,并且同一组行的首字母相同,我想添加一个边框到此分组的最后一行。有许多可变长度的分组。到目前为止,我有以下代码,并且我也粘贴了我正在寻找的内容。任何帮助表示赞赏。
谢谢!!
Function ExCap(Rng As Range)
Application.Volatile
ExCap = ""
For f = 1 To Len(Rng)
If Asc(Mid(Rng.Value, f, 1)) >= 65 And Asc(Mid(Rng.Value, f, 1)) <= 90 Then
ExCap = ExCap & Mid(Rng.Value, f, 1)
End If
Next f
End Function
Function GetColumnLetter(colNum As Long) As String
Dim vARR
vARR = Split(Cells(1, colNum).Address(True, False), "")
GetColumnLetter = vARR(0)
End Function
Function funcCreateList(argCreateList)
For Each Worksheet In ThisWorkbook.Worksheets
If argCreateList = Worksheet.Name Then
Exit Function ' if found - exit function
End If
Next Worksheet
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = argCreateList
End Function
Function InCom(s As String)
Dim i As Long
Dim result As String
If s = "" Then Exit Function
For i = 1 To Len(s) Step 2
On Error Resume Next
result = result & Left(s, 2) & ", "
s = Mid(s, 3, Len(s) - 2)
Next i
InCom = Left(result, Len(result) - 2)
End Function
Function IsFileOpen(FileName As String)
Dim iFilenum As Long
Dim iErr As Long
On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error GoTo 0
Select Case iErr
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error iErr
End Select
End Function
Sub Weekly_Report()
Dim wrpath As String, wmr As Workbook, wtd As Workbook, wed As [enter image description here][1]Workbook, ws1 As Worksheet
Dim LastRow As Long, myCol As String, LastCol As Long, Rng As Range, Piv As Worksheet
Application.ScreenUpdating = False
wrpath = "c:\mypathtoaraise”
ChDir (wrpath)
If IsFileOpen(wrpath & "wmr.xls") = 0 Then
Workbooks.Open (wrpath & "wmr.xls")
Else
Workbooks("wmr.xls").Activate
End If
Set wmr = Workbooks("wmrxls")
Set ws1 = Sheets("Sheet1")
LastRow = ws1.Range("A" & Rows.Count).End(xlUp).Row
Do Until LastRow = 1
Set Rng = Range("C" & LastRow)
Range("J" & LastRow) = InCom(ExCap(Rng))
Rng.Value = Range("J" & LastRow).Value
Set Rng = Range("G" & LastRow)
Range("K" & LastRow) = InCom(ExCap(Rng))
Rng.Value = Range("K" & LastRow).Value
LastRow = LastRow - 1
Loop
Range("J:K").ClearContents
LastRow = ws1.Range("A" & Rows.Count).End(xlUp).Row
LastCol = ws1.Range("A1").CurrentRegion.Columns.Count
myCol = GetColumnLetter(LastCol)
Rows("2:" & LastRow).Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B2:B" & LastRow) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A2:" & myCol & LastRow)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A2").Select
Columns("B:B").Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A2").Select
解决方案
还没有代码,但我会将边框默认为 xlbottom ,然后制作 2 if then 测试以删除边框并将其添加到下一个范围
用代码编辑:
FirstRow = FirstRow + 1
Set pdRng = Range("A" & FirstRow - 1)
Set piRng = Range("C" & FirstRow - 1)
Do Until FirstRow = LastRow + 1
Set dRng = Range("A" & FirstRow)
Set iRng = Range("C" & FirstRow)
If dRng <> pdRng Or iRng <> piRng Then
Range("A" & FirstRow & ":I" & FirstRow).Borders(xlEdgeBottom).LineStyle = xlContinuous
FirstRow = FirstRow + 1
Set pdRng = Range("A" & FirstRow - 1)
Set piRng = Range("C" & FirstRow - 1)
Else
dRng.ClearContents
Range("A" & FirstRow & ":I" & FirstRow).Borders(xlEdgeTop).LineStyle = xlNone
Range("A" & FirstRow & ":I" & FirstRow).Borders(xlEdgeBottom).LineStyle = xlContinuous
FirstRow = FirstRow + 1
Set piRng = Range("C" & FirstRow - 1)
End If
Loop
对 FirstRow 使用以下函数:
FirstRow = IIf(IsEmpty(Sheets("Sheet1").Range("B1")), Sheets("Sheet1").Range("B1").End(xlDown).Row, 1)
推荐阅读
- android-studio - Android Studio 构建问题
- java-8 - org.powermock.core.classloader.MockClassLoader:方法
()V 未找到 - flutter - 用户在 Flutter 中进行更改后如何在没有路由器导航的情况下自动刷新页面?
- python - 如何让 Discord 机器人激活另一个机器人?
- api - 币安期货最后订单 API 端点
- visual-studio-code - 我如何在 Visual Studio 中运行 python 代码来创建 GCP bigquery 数据集
- swift - 限制列表中的 API 请求
- node.js - React App 无法启动并给出错误
- java - 如何使用 appium 从内部存储中获取文件列表
- java - Spring Boot App 无法连接到 PostgreSQL 容器