搜索列表以生成不同的系列，然后绘制相应的值。

Question

首先，让我说我对这个网站和VBA都是新手(我在高中时上过速成班，所以我得到了基本的编码术语)。我已经找了好几天了，想找到能满足我需要的代码，但我什么也没找到。

基本上，我有一堆经过筛选的沙子样本。每个样本都有自己的单子。从这里开始，我有一个主摘要表，它收集我需要从这些其他表中绘制的数据，并将其放入一个表中。它还可以找到样本的类型和测试日期。目前有6种不同类型的样品。

另外，我需要用x轴上的日期和y轴上的百分比绘制汇总表。我需要每个样本类型有自己的系列。我已经到了正确划分所有6个系列的地方(虽然我确信代码效率很低)，但是我不知道如何从要绘制的示例类型旁边的列中获得值。换句话说，所有东西都被卡住在"0“的值上，因为它现在正在按字符串对其排序。

我已经把我的代码和我的excel工作表的文本版本放在下面。我很感谢你能帮我的忙！

'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“是类型。然后，您需要执行以下操作：

1. 在Excel中，您需要单独创建每个系列--因此，如果您有5种类型，则需要分别绘制每个系列。
2. 最简单的方法是按类型进行排序，对所有行进行循环，并确定边界，因此类型1可能是第2-11行、第212-15行等等。
3. 然后你就可以画出每一个系列

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

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