MACRO组织,分组,轮廓(需要调整宏适用的区域)

时间:2015-06-17 08:43:16

标签: excel vba excel-vba

如何从A4而不是A2应用此功能。我很满意的其他一切。我只是想了解我需要对此做出的任何更改。

是否需要在“设定人口”进行更改? 2?

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


lastRow = Range(Cells(99999, 1), Cells(99999, 1)).End(xlUp).row
Set pop = Range(Cells(2, 1), Cells(lastRow, 7))
sBeg = 2
sEnd = 2
y = 1
rpName = Cells(2, 1)
Range(Cells(1, 7), Cells(lastRow, 7)).NumberFormat = "0.00%"

For x = 2 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

非常感谢!

1 个答案:

答案 0 :(得分:0)

我添加了一个新变量StartFrom,因此您只需更改一次该值即可使其在不同的范围内工作。

另外,我更改了lastRow的定义,请查看Error in finding last used cell in VBA

尝试一下:

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