Question

我基本上试图获取每个位置的前十行的范围，如果小于十，那么它将使用最大范围

例如，如果下面的数据放在A栏中，则第一个范围是A2：A11第二个范围是A14：A16，第三个范围是A17：A26

Location
London
London
London
London
London
London
London
London
London
London
London
London
Liverpool
Liverpool
Liverpool
York
York
York
York
York
York
York
York
York
York
York
York
York
York
York

我正在尝试合并它，以便我可以使用以下方法一次制作多个饼图：

Charts.Add2
ActiveChart.SetSourceData Source:=Range("'MainSheet'!$T$3:$T$14")
ActiveChart.ChartType = xlPie
ActiveChart.SetElement (msoElementLegendRight)
ActiveChart.FullSeriesCollection(1).XValues = "='MainSheet'!$I$4:$I$14"
Sheets("MainSheet").Select

下载链接，例如excel文件：https://mega.co.nz/#!PhgWTB7a!Ie0HzaA66-vsR8nDpsQzsSlLZ9A4egoDzNtuWNR8uhU

替代下载链接：https://www.dropbox.com/s/f44be4vj2b82lx1/Example_Pies.xlsx

我不知道该怎么做，所以我非常感谢你的帮助。

Answer 1

大规模编辑：

根据上传的文件，这是一个有效的代码。优化取决于您。 经过测试和测试。

Sub CreateCharts()

    Dim Rng1 As Range, Rng2 As Range, Rng3 As Range
    Dim Val1 As Range, Val2 As Range, Val3 As Range
    Dim RngNames As Range

    Set RngNames = Sheets("MainSheet").Range("C4:C60")

    Set Rng1 = Range(GetTopRange(RngNames, "London", 10)).Offset(0, 6)
    Set Rng2 = Range(GetTopRange(RngNames, "Newcastle", 10)).Offset(0, 6)
    Set Rng3 = Range(GetTopRange(RngNames, "York", 10)).Offset(0, 6)

    Set Val1 = Rng1.Offset(0, 11)
    Set Val2 = Rng2.Offset(0, 11)
    Set Val3 = Rng3.Offset(0, 11)

    AddChart Rng1, Val1, "London"
    AddChart Rng2, Val2, "Newcastle"
    AddChart Rng3, Val3, "York"

End Sub

Sub AddChart(rLabel As Range, rValues As Range, sTitle As String)
    Dim Cht As Chart
    Set Cht = Charts.Add
    With Cht
        .Name = sTitle
        .ChartType = xlPie
        .SetSourceData Source:=Union(rLabel, rValues)
        '.HasTitle = True
        .ChartTitle.Characters.Text = sTitle
    End With
End Sub

Function GetTopRange(Rng As Range, StrLine As String, NumCount As Long) As String
    Application.Volatile
    Dim Cell As Range, URng As Range
    For Each Cell In Rng.SpecialCells(xlCellTypeConstants)
        If Cell.Value = StrLine Then
            If URng Is Nothing Then
                Set URng = Cell
            Else
                Set URng = Union(URng, Cell)
            End If
            If URng.Cells.Count = NumCount Then
                Exit For
            End If
        End If
    Next Cell
    GetTopRange = URng.Address
End Function

感谢。

Answer 2

我的2c：

Function TopRange(DataRange As Range, v)
Dim f As Range
    Set f = DataRange.Find(v, , xlValues, xlWhole)
    If Not f Is Nothing Then
        TopRange = f.Resize(Application.Min( _
             Application.CountIf(DataRange, v), 10)).Address()
    Else
        TopRange = "not found"
    End If
End Function

VBA循环通过一列，获取每个位置的前10个（或者最大值小于10）的范围

2 个答案: