代码运行时删除工作表中的边框线

我有一个成功地查看外部文件的代码,并将包含该特定条件的行复制/粘贴到当前工作簿中。 例如,我正在外部工作簿中searchSingapore ,称为“活动主项目文件”,并将包含Singapore所有行复制到当前打开的工作簿中。

发生的问题是,当我运行相同的代码两次时,工作表的最后一行上将存在一条边框线。 例如,当我运行代码时,它会将包含Singapore的信息复制到当前工作表“新即将开展的项目”中:

在这里输入图像描述

但是,当我再次运行代码时,它将在每列上创build一个边框线,如下图所示:

在这里输入图像说明

而我现在的代码是:

 Sub UpdateNewUpcomingProj() Dim wb1 As Workbook, wb2 As Workbook Dim ws1 As Worksheet, ws2 As Worksheet Dim copyFrom As Range Dim lRow As Long '<~~ Not Integer. Might give you error in higher versions of excel Dim strSearch As String Set wb1 = Application.Workbooks.Open("U:\Active Master Project.xlsm") Set ws1 = wb1.Worksheets("New Upcoming Projects") strSearch = "Singapore" With ws1 '~~> Remove any filters .AutoFilterMode = False '~~> I am assuming that the names are in Col A '~~> if not then change A below to whatever column letter lRow = .Range("A" & .Rows.Count).End(xlUp).Row With .Range("A1:A" & lRow) .AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*" Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow End With .AutoFilterMode = False End With '~~> Destination File Set wb2 = ThisWorkbook Set ws2 = wb2.Worksheets("New Upcoming Projects") With ws2 If Application.WorksheetFunction.CountA(.Cells) <> 0 Then lRow = .Cells.Find(What:="*", _ After:=.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row Else lRow = 2 End If copyFrom.Copy .Rows(lRow) .Rows.RemoveDuplicates Array(2), xlNo End With End Sub 

是否有任何改进或额外的代码,我必须补充,使边界线将消失?

我假设这种格式来自源工作表。 如果是这样,你可以PasteSpecial只是粘贴值,保持目标格式。 要做到这一点,只需更换

 copyFrom.Copy .Rows(lRow) 

 copyFrom.Copy .Rows(lRow).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False 

如果您确实需要源表格中的某些格式,则可以使用xlPasteAllExceptBorders而不是xlPasteValues

因为EyePeaSea说你可以通过vba代码去除边框,例如

 ThisWorkbook.Worksheets("XY").Range("A1", "Z99").Borders.LineStyle = xlNone 

在你的情况下,代码应该是(未经testing)

 copyFrom.Borders.LineStyle = xlNone 

复制行后

select性粘贴,将粘贴到列A中的第一个空单元格

 copyfrom.Copy ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues Application.CutCopyMode = 0 

删除重复项后,您可以添加此行

 .UsedRange.Offset(lRow).Borders.Value = 0 

这将从插入的行中删除任何边界

PS:我仍然不明白这些边界来自哪里,最有可能来自原始工作表.. 🙂

在代码的末尾,请添加一行来格式化第三行的绘图。

所以基本上在最后两行wb1.Select'请确保你在这里select正确的一个wb1或wb2,然后再试一行(“3:3”)。selectSelection.Copy行(“4:10000”)。selectselect.PasteSpecial Paste:= xlPasteFormats,Operation:= xlNone,_ SkipBlanks:= False,Transpose:= False Application.CutCopyMode = False end with end sub这是你的代码的最后一行