VBA：代码审核并为经常更改的文件设置边框

Question

请帮我设置一组字段的边框，这些字段用于根据用户提供的数据（一周的周数）进行更改，我尝试了一些事情，但没有任何事情发生，因为当字段发生变化时，它会去疯狂的

我第一次将值设定为2018年1月＆amp; 2018年2月

代码

Sub ClearPage()

    Sheets("WeekWise_Revenue").Select
    Cells.Select
    Selection.Delete Shift:=xlUp

    Call Set_Basicdetails

End Sub

Sub Set_Basicdetails()

    Range("3:3,5:5").Select
    Range("C3").Activate
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Range("4:4,6:6").Select
    Range("C4").Activate
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With

' Macro2 Macro

    Range("A2").Select
    ActiveCell.FormulaR1C1 = "Country"
    Range("A2:B2").Select
    Selection.Merge


    Range("A3").Select
    ActiveCell.FormulaR1C1 = "US"
    Range("A3:B4").Select
    Selection.Merge
      With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
      End With

    Range("A5").Select
    ActiveCell.FormulaR1C1 = "India"
    Range("A5:B6").Select
    Selection.Merge
      With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
      End With


    Range("C3").Select
    ActiveCell.FormulaR1C1 = "Senior Ops"
    Range("C4").Select
    ActiveCell.FormulaR1C1 = "Ops Eng"
    Range("C5").Select
    ActiveCell.FormulaR1C1 = "Senior Ops"
    Range("C6").Select
    ActiveCell.FormulaR1C1 = "Ops Eng"
    Range("C7").Select
    ActiveCell.FormulaR1C1 = "Revenue"

    Columns("A:C").Select
    Columns("A:C").EntireColumn.AutoFit

Call SetDate

End Sub

Sub SetDate()

    Dim intDay As Integer, firstIter As Integer
    Dim startMonth As Date, endMonth As Date
    Dim str As String
    Dim IsStartMonth As Boolean, IsEndMonth As Boolean
    Dim Rng As Range, rng1 As Range, rng2 As Range
    Dim i As Long
    Dim ws As Worksheet

    Application.ScreenUpdating = False
    firstIter = 1
    Set ws = ThisWorkbook.Sheets("WeekWise_Revenue")  'change Sheet4 to your sheet
    IsStartMonth = False
    IsEndMonth = False
    Do
        If Not IsStartMonth Then
        'get start date
            str = InputBox("Enter Start Date in month-year format " & vbCrLf & "(like Sep 2017 or September 2017)", "Date")
            If IsDate(str) Then         'if entery is valid date
                startMonth = str
                IsStartMonth = True
            ElseIf IsEmpty(str) Then    'if nothing is entered
                IsStartMonth = True
            ElseIf StrPtr(str) = 0 Then 'user clicks close
                IsStartMonth = True
                Exit Sub
            Else                        'display input box again
                Call MsgBox("Enter a valid date", vbCritical + vbOKOnly, "Date Only")
            End If
        Else
        'get end date
            str = InputBox("Enter End Date in month-year format " & vbCrLf & "(like Sep 2017 or September 2017)", "Date")
            If IsDate(str) Then         'if entery is valid date
                endMonth = DateAdd("d", -1, DateAdd("m", 1, str))
                IsEndMonth = True
            ElseIf IsEmpty(str) Then    'if nothing is entered
                IsEndMonth = True
            ElseIf StrPtr(str) = 0 Then 'user clicks close
                IsEndMonth = True
                Exit Sub
            Else                        'display input box again
                Call MsgBox("Enter a valid date", vbCritical + vbOKOnly, "Date Only")
            End If
        End If
    Loop Until IsStartMonth And IsEndMonth

    Set Rng = ws.Range("D2")
    ws.Range("C2") = "Role"
    Set rng1 = Rng.Offset(-1, i)
    intDay = intDay + 1

    Do
        If Format(startMonth + intDay, "ddd") = "Mon" Then      'check whether date is Monday
            Rng.Offset(-1, i).Value = MonthName(Format(startMonth + intDay, "m"))
            Rng.Offset(0, i).Value = Format(startMonth + intDay, "d")   'display monday dates
            i = i + 1
            intDay = intDay + 7

            'merge cells in Row 1
            If rng1.Value = Rng.Offset(-1, i - 1).Value Then
                If firstIter <> 1 Then
                    Rng.Offset(-1, i - 1).Value = ""
                End If
                firstIter = 0
                With Range(rng1, Rng.Offset(-1, i - 1))
                    .Merge
                    .HorizontalAlignment = xlCenter
                End With
            Else
                Set rng1 = Rng.Offset(-1, i - 1)
            End If

        Else
            intDay = intDay + 1
        End If
    Loop Until CDate(startMonth + intDay) > CDate(endMonth) 'loop till start date is less then end date
Application.ScreenUpdating = True

Call Set_border
End Sub

代码设置边框我面临的问题

Sub Set_border()

    Range("D1").Select
    LastRow = Cells(Rows.Count, 10).End(xlUp).Row
    Range("D1:D" & LastRow).Select
    ''ActiveCell.Offset(4, 0).Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select


    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With

End Sub

我期待这样的事情

这工作正常，但下次我运行代码并仅输入2018年1月，但边框将被添加到之前选择的所有文件中，我试图在主代码开始之前删除所有字段但面对同样的问题

Answer 1

我对错误的猜测是在LastRow定义中使用第10列。我在下面做了一些改动。

从您的示例数据集中，似乎“Role”在C列中，“January”在D列中开始？

如果是这样，我认为您需要将代码调整为：

Sub Set_border()
    Range("C2").Select
    LastRow = Cells(Rows.Count, 3).End(xlUp).Row
    LastCol = Cells(2, Columns.Count).End(xlToLeft).Column
    Range("A2:" & Cells(LastRow, LastCol).Address).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    Range("D1:" & Cells(1, LastCol).Address).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
End Sub