運行代碼后刪除工作表中的邊界線

Question

我有一個代碼，可以成功地查看外部文件並將包含特定條件的行復制/粘貼到當前工作簿中。 例如，我正在名為Active master project file的外部工作簿中搜索Singapore ，並將包含Singapore所有行復制到當前打開的工作簿中。

發生的問題是，當我兩次運行相同的代碼時，工作表的最后一行將存在一條邊框線。 例如，當我運行代碼時，它將把包含Singapore的信息復制粘貼到當前工作表中，稱為“新的即將來臨的項目”：

但是，當我再次運行代碼時，它將在每列上創建一條邊界線，如下圖所示：

我現在擁有的代碼是：

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

我是否需要添加任何改進或其他代碼以使邊界線消失？

Answer 1

正如EyePeaSea所說，您可以通過vba代碼刪除邊框，例如

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

在您的情況下，代碼應（未試用）

copyFrom.Borders.LineStyle = xlNone

復制行之后

Answer 2

我認為這種格式來自源工作表。 如果是這樣，則可以使用PasteSpecial粘貼值，並保持目標格式。 為此，只需更換

copyFrom.Copy .Rows(lRow)

與

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

如果確實需要從源工作表進行某種格式設置，則可以使用xlPasteAllExceptBorders代替xlPasteValues 。

Answer 3

選擇性粘貼，它將粘貼到列A中的第一個空單元格

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

Answer 4

您可以在刪除重復項后添加此行

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

這將從插入的行中刪除所有邊框

ps：我仍然不明白這些邊界的來源，最有可能是來自原始工作表的.. :)

Answer 5

在代碼末尾，請添加新行以格式化第三行的繪畫。

所以基本上在最后兩行wb1.Select'之前，請確保在此處選擇正確的wb1或wb2，然后重試Rows（“ 3：3”）。Select Selection.Copy Rows（“ 4：10000”）。Select Selection .PasteSpecial Paste：= xlPasteFormats，Operation：= xlNone，_ SkipBlanks：= False，Transpose：= False Application.CutCopyMode = False結尾為end sub'這是代碼的最后一行