Vba 组织、分组、轮廓的宏（需要调整宏应用的区域）

如何从A4而不是A2应用此选项。其他一切我都满意。我只是想了解我需要对此进行的任何更改

“设定人口”是否需要改变？2号

---

非常感谢

我添加了一个新变量

StartFrom

，这样您只需更改一次该值即可使其在不同的范围内工作

另外，我更改了

lastRow

的定义，请看

尝试一下：

Sub formatresults()

Dim lastRow As Long
Dim pop As Range
Dim rpSet As Range
Dim rpSetNames As Range
Dim sBeg As Integer
Dim sEnd As Integer
Dim rpName As String
Dim x As Integer
Dim y As Integer, _
    StartFrom As Integer

StartFrom = 4

lastRow = Range("A" & Rows.Count).End(xlUp).Row
Set pop = Range(Cells(StartFrom, 1), Cells(lastRow, 7))
sBeg = StartFrom
sEnd = StartFrom
y = 1
rpName = Cells(StartFrom, 1) '----
Range(Cells(1, 7), Cells(lastRow, 7)).NumberFormat = "0.00%"

For x = StartFrom To lastRow '----

    If Cells(sEnd + 1, 1) = rpName Then
        sEnd = sEnd + 1
    Else
        Set rpSet = Range(Cells(sBeg, 1), Cells(sEnd, 7))
        Set rpSetNames = Range(Cells(sBeg, 1), Cells(sEnd, 1))
        rpSet.BorderAround Weight:=xlMedium

        If y Mod 2 = 1 Then rpSetNames.Interior.ColorIndex = 15

        sBeg = sEnd + 1
        sEnd = sEnd + 1
        rpName = Cells(sBeg, 1)
        y = y + 1
    End If

Next x

End Sub

---

我从添加了一个新变量

StartFrom，这样您只需更改一次该值即可使其在不同的范围内工作

另外，我更改了
lastRow
的定义，请看

尝试一下：

Sub formatresults()

Dim lastRow As Long
Dim pop As Range
Dim rpSet As Range
Dim rpSetNames As Range
Dim sBeg As Integer
Dim sEnd As Integer
Dim rpName As String
Dim x As Integer
Dim y As Integer, _
    StartFrom As Integer

StartFrom = 4

lastRow = Range("A" & Rows.Count).End(xlUp).Row
Set pop = Range(Cells(StartFrom, 1), Cells(lastRow, 7))
sBeg = StartFrom
sEnd = StartFrom
y = 1
rpName = Cells(StartFrom, 1) '----
Range(Cells(1, 7), Cells(lastRow, 7)).NumberFormat = "0.00%"

For x = StartFrom To lastRow '----

    If Cells(sEnd + 1, 1) = rpName Then
        sEnd = sEnd + 1
    Else
        Set rpSet = Range(Cells(sBeg, 1), Cells(sEnd, 7))
        Set rpSetNames = Range(Cells(sBeg, 1), Cells(sEnd, 1))
        rpSet.BorderAround Weight:=xlMedium

        If y Mod 2 = 1 Then rpSetNames.Interior.ColorIndex = 15

        sBeg = sEnd + 1
        sEnd = sEnd + 1
        rpName = Cells(sBeg, 1)
        y = y + 1
    End If

Next x

End Sub