搜索一个列表来制作不同的系列，然后绘制它们对应的值

Question

首先声明我是这个网站的新手，VBA（我在高中参加了速成班，所以我掌握了基本的编码术语）。我已经找了好几天来找到可以满足我需要的代码，但我什么也没找到。

基本上我有一堆已经过筛的沙样。每个样本都有自己的 sheet。从这里开始，我有一个主摘要 Sheet，它收集我需要从这些其他 sheet 中绘制的数据，并将其放入 table 中。它还会找到样本类型和测试日期。有 6 种不同类型的样本（到目前为止）。

此外，我需要绘制摘要 table，x 轴为日期，y 轴为百分比。我需要每个样本类型都有自己的系列。我已经正确划分了所有 6 个系列（尽管我确信代码效率非常低），但我无法弄清楚如何从要绘制的样本类型旁边的列中获取值。换句话说，所有内容都停留在“0”值，因为它现在正在按字符串排序。

我把我的代码和我的 excel sheet 的文本版本放在下面。我很感激你能给我的任何帮助！

'Sheet           Date       Type    Sieve #40
'Truck 47533    4/15/2016   Truck       55%
'Truck 47272    4/4/2016    Truck       55%
'47272          4/4/2016    CoA         48%
'Basement 4-4   4/4/2016    Basement    55%
'Bin2 4-4       4/4/2016    Bin2        55%
'Bin1 4-4       4/4/2016    Bin1        55%
'Hopper 4-4     4/4/2016    Hopper      57%
'Basement 4-1   4/1/2016    Basement    58%
'Bin2 4-1       4/1/2016    Bin2        54%
'Bin1 4-1       4/1/2016    Bin1        58%
'Hopper 4-1     4/1/2016    Hopper      56%
'Truck 46892    4/1/2016    Truck       56%
'46892          4/1/2016    CoA         47%
'Basement 3-24  3/24/2016   Basement    55%
'Bin2 3-24      3/24/2016   Bin2        57%
'Bin1 3-24      3/24/2016   Bin1        61%
'Hopper 3-24    3/24/2016   Hopper      50%    

Sub ChartingSub()

Dim LastRow As Long
Dim c As Range
Dim Rng1 As Range
Dim Truck As Range
Dim Hopper As Range
Dim Bin1 As Range
Dim Bin2 As Range
Dim Basement As Range
Dim coa As Range
Dim NewSand As Range
Dim ShName As String
Dim dates As Range

    If ActiveSheet.ChartObjects.Count > 0 Then
        ActiveSheet.ChartObjects.Delete
    End If

    With ActiveSheet
        LastRow = .Range("D" & .Rows.Count).End(xlUp).Row
        Set Rng1 = .Range("C2:C" & LastRow)
        ShName = .Name
    End With

With ActiveSheet
    Set dates = .Range("B2:B" & LastRow)
End With

    For Each c In Rng1
        If c.Value = "Truck" Then
            If Not Truck Is Nothing Then
                Set Truck = Union(Truck, c)
            Else
                Set Truck = c
            End If

         ElseIf c.Value = "Hopper" Then
            If Not Hopper Is Nothing Then
                Set Hopper = Union(Hopper, c)
            Else
                Set Hopper = c
            End If
        ElseIf c.Value = "Bin1" Then
            If Not Bin1 Is Nothing Then
                Set Bin1 = Union(Bin1, c)
            Else
                Set Bin1 = c
            End If
        ElseIf c.Value = "Bin2" Then
            If Not Bin2 Is Nothing Then
                Set Bin2 = Union(Bin2, c)
            Else
                Set Bin2 = c
            End If
        ElseIf c.Value = "Basement" Then
            If Not Basement Is Nothing Then
                Set Basement = Union(Basement, c)
            Else
                Set Basement = c
            End If
        ElseIf c.Value = "CoA" Then
            If Not coa Is Nothing Then
                Set coa = Union(coa, c)
            Else
                Set coa = c
            End If
        ElseIf c.Value = "NewSand" Then
            If Not NewSand Is Nothing Then
                Set NewSand = Union(NewSand, c)
            Else
                Set NewSand = c
            End If
        End If
    Next

Dim cht As Chart
Set cht = ActiveWorkbook.Charts.Add
Set cht = cht.Location(Where:=xlLocationAsObject, Name:=ShName)
    With cht
        .ChartType = xlXYScatterLines
        .HasTitle = True
        .ChartTitle.Text = "Sieve #40 Trend"
    End With

Dim t As Series
Set t = cht.SeriesCollection.NewSeries
With t
    .Values = Truck
    .XValues = dates
    .Name = "Truck"
End With

Dim h As Series
Set h = cht.SeriesCollection.NewSeries
With h
    .Values = Hopper
    .XValues = dates
    .Name = "Hopper"
End With

Dim b As Series
Set b = cht.SeriesCollection.NewSeries
With b
    .Values = Basement
    .XValues = dates
    .Name = "Basement Reclaim"
End With

Dim b1 As Series
Set b1 = cht.SeriesCollection.NewSeries
With b1
    .Values = Bin1
    .XValues = dates
    .Name = "Bin1"
End With

Dim b2 As Series
Set b2 = cht.SeriesCollection.NewSeries
With b2
    .Values = Bin2
    .XValues = dates
    .Name = "Bin2"
End With

Dim cert As Series
Set cert = cht.SeriesCollection.NewSeries
With cert
    .Values = coa
    .XValues = dates
    .Name = "CoA"
End With

'Dim ns As Series
'Set ns = cht.SeriesCollection.NewSeries
'With ns
    '.Values = NewSand
    '.XValues = dates
    '.Name = "New Resin Sand"
'End With

End Sub

Answer 1

如果您需要 X 是日期，Y 是百分比，"Z" 是类型的图表。然后你需要做以下事情：

在 Excel 中，您需要单独创建每个系列 - 所以如果您有 5 种类型，那么您需要分别绘制每一种。
最简单的方法是按类型排序，遍历所有行，并找出边界，因此类型 1 可能是第 2-11 行，类型 2 可能是第 12-15 行，等等。
然后你可以绘制每个系列

类似这样的东西 - 使用上面找到开始和结束的地方：

For a = 1 To lastrow
    With ActiveChart 
            With .SeriesCollection.NewSeries 
                .XValues = Sheets(strName).Range("E" & startx & ":E" & endx)
                .Values = Sheets(strName).Range("E" & starty & ":E" & endy)
                .Name = strName 
            End With 
        End If 
    End With 
Next a

搜索一个列表来制作不同的系列，然后绘制它们对应的值

Searching a list to make different series, then plotting their corresponding values

excel

plot

vba

excel-2013