按降序排列图表
Sort Chart In Descending Order
想知道是否可以按降序对图表数据显示进行排序：
我不知道该怎么做。
我唯一知道的是如何浏览系列值:
Set s = cht.FullSeriesCollection(1)
For i = 1 To s.Points.Count
If s.Values(i) < 0 Then 'JustAnExample
'WhateverIwant
End If
Next i
此外，上面的图表是使用工作表中的数据构建的：
请测试下一个解决方案。由于您没有 post 您的图表创建代码，我想象了一些这样做的东西：
Sub createStackedColChart_Arrays()
Dim sh As Worksheet, arr1, arr2, arrN, arrD
Dim chartName As String, arrSort, i As Long
Set sh = ActiveSheet 'use here the necessary sheet
chartName = "MyChartSorted"
arr1 = sh.Range("A2:D2").value 'first series array
arr2 = sh.Range("A3:D3").value 'second series array
arrN = sh.Range("A1:D1").value 'X axes values array
'Create the reference array of summarized values per column:
ReDim arrSort(1 To UBound(arr1, 2))
For i = 1 To UBound(arr1, 2)
arrSort(i) = arr1(1, i) + CLng(arr2(1, i))
Next i
'_______________________________________________
'sort arrays according to reference one (arrSort):
sortArrs arrSort, arrN, arr1, arr2
'if the (testing) chart exists, delete it:
On Error Resume Next
ActiveSheet.ChartObjects(chartName).Delete
On Error GoTo 0
'create the necessary chart:
With ActiveSheet.ChartObjects.Add(left:=100, width:=375, top:=75, height:=225).Chart
.Parent.Name = chartName 'name it to have a reference when delete it
.SeriesCollection.NewSeries.Values = arr1 'add first series
.SeriesCollection.NewSeries.Values = arr2 'add first series
.HasTitle = True 'set it to allow a Title
.chartTitle.text = "My Sorted Chart" 'set the Title
.ChartType = xlColumnStacked 'set the chart type
.SeriesCollection(1).XValues = arrN 'add values to X axis
End With
End Sub
Sub sortArrs(arrS, arrN, arr1, arr2) 'being passed byRef, the initial arrays are filtered
Dim i As Long, nxtEl As Long, tmp, tmpN, tmp1, tmp2
For i = LBound(arrS) To UBound(arrS) - 1 'iterate between the arrS elements (except the last):
For nxtEl = i + 1 To UBound(arrS) 'iterate between the arrS elements (starting from the second one):
If arrS(i) < arrS(nxtEl) Then 'sort the arrays according to the element values (< means descending)
tmp = arrS(i): tmpN = arrN(1, i): tmp1 = arr1(1, i): tmp2 = arr2(1, i)
arrS(i) = arrS(nxtEl): arrN(1, i) = arrN(1, nxtEl)
arr1(1, i) = arr1(1, nxtEl): arr2(1, i) = arr2(1, nxtEl)
arrS(nxtEl) = tmp: arrN(1, nxtEl) = tmpN
arr1(1, nxtEl) = tmp1: arr2(1, nxtEl) = tmp2
End If
Next nxtEl
Next i
End Sub
请在测试后发送一些反馈。
如果您需要图表是动态的，意思是在引用范围内（A1:D3，在您的示例中）发生任何值更改时刷新它，sheet Change 事件可以是用过的。如果在上述范围内发生变化，事件将调用上述函数。如果需要，请复制涉及的sheet代码模块中的下一段代码：
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("A1:D3")) Is Nothing Then
createStackedColChart_Arrays 'if need to change the Sub name, please adapt it here...
End If
End Sub
已编辑:
使用 sheet 中所有现有 rows/columns 的更详细的动态版本。最后一列在第一行（第 Headers 列）上计算：
Sub createStackedColChart_Arrays_Dynamic()
Dim sh As Worksheet, lastR As Long, lastCol As String, arrN, arrSort
Dim chartName As String, dict As Object, i As Long, j As Long
Set sh = ActiveSheet 'use here the necessary sheet
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row 'last row of A:A column
lastCol = Split(sh.cells(1, sh.Columns.count).End(xlToLeft).Address, "$")(1) 'extract the last column Letter
chartName = "MyChartSorted"
Set dict = CreateObject("Scripting.Dictionary") 'create the necessary dictionary object
For i = 2 To lastR
dict.Add i - 1, sh.Range("A" & i & ":" & lastCol & i).value 'place in the dictionary the ranges to become chart series
Next i
arrN = sh.Range("A1:" & lastCol & 1).value 'X axes values (names array)
'Create the reference array of summarized values per column:
ReDim arrSort(1 To UBound(arrN, 2))
For i = 1 To UBound(arrN, 2)
For j = 1 To dict.count
arrSort(i) = arrSort(i) + dict(j)(1, i) 'add each column value to summarize
Next j
Next i
'_______________________________________________
'Debug.Print Join(arrSort, "|"): Stop
sortDArrs arrSort, arrN, dict 'sort the involved arrays (ranges) according to arrSort sorted descending
'if the (testing) chart exists, delete it:
On Error Resume Next
ActiveSheet.ChartObjects(chartName).Delete
On Error GoTo 0
'create the necessary chart:
With ActiveSheet.ChartObjects.Add(left:=100, width:=375, top:=80, height:=225).Chart
.Parent.Name = chartName 'name it to have a reference when delete it
For i = 1 To dict.count 'add a new series from the dictionary (sorted) items:
.SeriesCollection.NewSeries.Values = dict(i) 'add the series
Next i
.HasTitle = True 'set it to allow a Title
.chartTitle.text = "My Sorted Chart" 'set the Title
.ChartType = xlColumnStacked 'set the chart type
.SeriesCollection(1).XValues = arrN 'add values to X axis
End With
End Sub
Sub sortDArrs(arrS, arrN, dict As Object) 'sort descending all involved arrays/ranges
Dim i As Long, nxtEl As Long, tmp, tmpN, arrTemp, arrT, k As Long, j As Long
ReDim arrTemp(dict.count - 1): ReDim arrT(1 To 1, 1 To UBound(arrN, 2))
For i = LBound(arrS) To UBound(arrS) - 1 'iterate between the arrS elements (except the last):
For nxtEl = i + 1 To UBound(arrS) 'iterate between the arrS elements (starting from the second one):
If arrS(i) < arrS(nxtEl) Then 'sort the arrays according to the element values (< means descending)
tmp = arrS(i): tmpN = arrN(1, i) 'memorize the element temporaty walue
For k = 0 To UBound(arrTemp): arrTemp(k) = dict(k + 1)(1, i): Next k 'do the same for each dictionary item
arrS(i) = arrS(nxtEl): arrN(1, i) = arrN(1, nxtEl)
For k = 1 To dict.count - 1 'the arrays content of a dictionary item cannot be changed directly!!!
arrT = dict(k): arrT(1, i) = dict(k)(1, nxtEl): dict(k) = arrT 'it cam be changed in this way
Next k
arrS(nxtEl) = tmp: arrN(1, nxtEl) = tmpN 'switch the array element value to the memorized one
For k = 1 To dict.count 'do the same in each dictionary item array:
arrT = dict(k): arrT(1, nxtEl) = arrTemp(k - 1): dict(k) = arrT
Next k
End If
Next nxtEl
Next i
End Sub
sheet Change 事件应该有必要的手动调整。可以自动判断，但是，为了避免运行代码每次添加header或者最后一行的值，还应该针对一个特殊的单元格和跳过[=15的事件=] 运行 添加新范围时。让我们说“停止”这个词。删除后，一切都应该正常工作（自动计算 lastR 和 LastCol 类似于上面的代码）。
想知道是否可以按降序对图表数据显示进行排序：
我不知道该怎么做。
我唯一知道的是如何浏览系列值:
Set s = cht.FullSeriesCollection(1)
For i = 1 To s.Points.Count
If s.Values(i) < 0 Then 'JustAnExample
'WhateverIwant
End If
Next i
此外，上面的图表是使用工作表中的数据构建的：
请测试下一个解决方案。由于您没有 post 您的图表创建代码，我想象了一些这样做的东西：
Sub createStackedColChart_Arrays()
Dim sh As Worksheet, arr1, arr2, arrN, arrD
Dim chartName As String, arrSort, i As Long
Set sh = ActiveSheet 'use here the necessary sheet
chartName = "MyChartSorted"
arr1 = sh.Range("A2:D2").value 'first series array
arr2 = sh.Range("A3:D3").value 'second series array
arrN = sh.Range("A1:D1").value 'X axes values array
'Create the reference array of summarized values per column:
ReDim arrSort(1 To UBound(arr1, 2))
For i = 1 To UBound(arr1, 2)
arrSort(i) = arr1(1, i) + CLng(arr2(1, i))
Next i
'_______________________________________________
'sort arrays according to reference one (arrSort):
sortArrs arrSort, arrN, arr1, arr2
'if the (testing) chart exists, delete it:
On Error Resume Next
ActiveSheet.ChartObjects(chartName).Delete
On Error GoTo 0
'create the necessary chart:
With ActiveSheet.ChartObjects.Add(left:=100, width:=375, top:=75, height:=225).Chart
.Parent.Name = chartName 'name it to have a reference when delete it
.SeriesCollection.NewSeries.Values = arr1 'add first series
.SeriesCollection.NewSeries.Values = arr2 'add first series
.HasTitle = True 'set it to allow a Title
.chartTitle.text = "My Sorted Chart" 'set the Title
.ChartType = xlColumnStacked 'set the chart type
.SeriesCollection(1).XValues = arrN 'add values to X axis
End With
End Sub
Sub sortArrs(arrS, arrN, arr1, arr2) 'being passed byRef, the initial arrays are filtered
Dim i As Long, nxtEl As Long, tmp, tmpN, tmp1, tmp2
For i = LBound(arrS) To UBound(arrS) - 1 'iterate between the arrS elements (except the last):
For nxtEl = i + 1 To UBound(arrS) 'iterate between the arrS elements (starting from the second one):
If arrS(i) < arrS(nxtEl) Then 'sort the arrays according to the element values (< means descending)
tmp = arrS(i): tmpN = arrN(1, i): tmp1 = arr1(1, i): tmp2 = arr2(1, i)
arrS(i) = arrS(nxtEl): arrN(1, i) = arrN(1, nxtEl)
arr1(1, i) = arr1(1, nxtEl): arr2(1, i) = arr2(1, nxtEl)
arrS(nxtEl) = tmp: arrN(1, nxtEl) = tmpN
arr1(1, nxtEl) = tmp1: arr2(1, nxtEl) = tmp2
End If
Next nxtEl
Next i
End Sub
请在测试后发送一些反馈。
如果您需要图表是动态的，意思是在引用范围内（A1:D3，在您的示例中）发生任何值更改时刷新它，sheet Change 事件可以是用过的。如果在上述范围内发生变化，事件将调用上述函数。如果需要，请复制涉及的sheet代码模块中的下一段代码：
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("A1:D3")) Is Nothing Then
createStackedColChart_Arrays 'if need to change the Sub name, please adapt it here...
End If
End Sub
已编辑:
使用 sheet 中所有现有 rows/columns 的更详细的动态版本。最后一列在第一行（第 Headers 列）上计算：
Sub createStackedColChart_Arrays_Dynamic()
Dim sh As Worksheet, lastR As Long, lastCol As String, arrN, arrSort
Dim chartName As String, dict As Object, i As Long, j As Long
Set sh = ActiveSheet 'use here the necessary sheet
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row 'last row of A:A column
lastCol = Split(sh.cells(1, sh.Columns.count).End(xlToLeft).Address, "$")(1) 'extract the last column Letter
chartName = "MyChartSorted"
Set dict = CreateObject("Scripting.Dictionary") 'create the necessary dictionary object
For i = 2 To lastR
dict.Add i - 1, sh.Range("A" & i & ":" & lastCol & i).value 'place in the dictionary the ranges to become chart series
Next i
arrN = sh.Range("A1:" & lastCol & 1).value 'X axes values (names array)
'Create the reference array of summarized values per column:
ReDim arrSort(1 To UBound(arrN, 2))
For i = 1 To UBound(arrN, 2)
For j = 1 To dict.count
arrSort(i) = arrSort(i) + dict(j)(1, i) 'add each column value to summarize
Next j
Next i
'_______________________________________________
'Debug.Print Join(arrSort, "|"): Stop
sortDArrs arrSort, arrN, dict 'sort the involved arrays (ranges) according to arrSort sorted descending
'if the (testing) chart exists, delete it:
On Error Resume Next
ActiveSheet.ChartObjects(chartName).Delete
On Error GoTo 0
'create the necessary chart:
With ActiveSheet.ChartObjects.Add(left:=100, width:=375, top:=80, height:=225).Chart
.Parent.Name = chartName 'name it to have a reference when delete it
For i = 1 To dict.count 'add a new series from the dictionary (sorted) items:
.SeriesCollection.NewSeries.Values = dict(i) 'add the series
Next i
.HasTitle = True 'set it to allow a Title
.chartTitle.text = "My Sorted Chart" 'set the Title
.ChartType = xlColumnStacked 'set the chart type
.SeriesCollection(1).XValues = arrN 'add values to X axis
End With
End Sub
Sub sortDArrs(arrS, arrN, dict As Object) 'sort descending all involved arrays/ranges
Dim i As Long, nxtEl As Long, tmp, tmpN, arrTemp, arrT, k As Long, j As Long
ReDim arrTemp(dict.count - 1): ReDim arrT(1 To 1, 1 To UBound(arrN, 2))
For i = LBound(arrS) To UBound(arrS) - 1 'iterate between the arrS elements (except the last):
For nxtEl = i + 1 To UBound(arrS) 'iterate between the arrS elements (starting from the second one):
If arrS(i) < arrS(nxtEl) Then 'sort the arrays according to the element values (< means descending)
tmp = arrS(i): tmpN = arrN(1, i) 'memorize the element temporaty walue
For k = 0 To UBound(arrTemp): arrTemp(k) = dict(k + 1)(1, i): Next k 'do the same for each dictionary item
arrS(i) = arrS(nxtEl): arrN(1, i) = arrN(1, nxtEl)
For k = 1 To dict.count - 1 'the arrays content of a dictionary item cannot be changed directly!!!
arrT = dict(k): arrT(1, i) = dict(k)(1, nxtEl): dict(k) = arrT 'it cam be changed in this way
Next k
arrS(nxtEl) = tmp: arrN(1, nxtEl) = tmpN 'switch the array element value to the memorized one
For k = 1 To dict.count 'do the same in each dictionary item array:
arrT = dict(k): arrT(1, nxtEl) = arrTemp(k - 1): dict(k) = arrT
Next k
End If
Next nxtEl
Next i
End Sub
sheet Change 事件应该有必要的手动调整。可以自动判断，但是，为了避免运行代码每次添加header或者最后一行的值，还应该针对一个特殊的单元格和跳过[=15的事件=] 运行 添加新范围时。让我们说“停止”这个词。删除后，一切都应该正常工作（自动计算 lastR 和 LastCol 类似于上面的代码）。