excel-设置/迭代动态范围

Question

EDIT....Boss threw me a curveball;

i'd like to pull out values for several ranges of data in excel. The ranges are defined by date.

sDate     variable    aDate           result
1/2/2012  totalN      1/3/2012        9     
1/2/2012  Nitrate     1/4/2012        ND
1/8/2012  totalN      1/10/2012       7.2
1/9/2012  EC          1/10/2012       8
1/9/2012  totalN      1/12/2012       8.4
1/9/2012  Nitrate     1/12/2012       ND

so, for the above, I'd like to pull variable, aDate & result of each unique sDate-variable combination. I have a set output .xls that would need to be populated, in the following format:

date     TriCHL    aDate     DiCHL    aDate     totalN    aDate     Nitrate    aDate     BEN    aDate     EC    aDate
1/2/2012 -         -         -        -         9         1/3/2012  ND         1/4/2012  -      -         -     -
1/8/2012 -         -         -        -         7.2       1/10/2012 -          -         -      -         -     -
1/9/2012 -         -         -        -         8.4       1/12/2012 ND         1/12/2012 -      -         8     1/10/2012

VBA would be OK, filling an array with unique values, then looping over the array and selecting from the entire range, then extracting values??

I'm lost

thanks for any help!

Edit

Here's my solution; may not be elegant, but it's functional

Sub ProcessData()

Dim sRng As Range       'starting position of SAMPDATE colrow of input data from lab    ***static***
Dim endsRng As Range    'end SAMPDATE colrow of input data from lab
Dim Rng As Range        'total range of SAMPDATE colrow of input data from lab
Dim row As Object       'row object for input data iteration
Dim sDate As Range      'starting colrow of unique sample dates on output sheet         ***static***
Dim endsDate As Range   'end colrow of unique sample dates on output sheet
Dim totalrng As Range   'total range of unique sample dates on output sheet
Dim datad As String     'sample date on output sheet
Dim datav As String     'chemical variable name on output sheet
Dim i, j As Integer     'used for iterating the output matrix
Dim finalr As String    'final result values from the input lab data
Dim finald As String    'final anadate values from the input lab data

'lets get the last row of the input data
Sheets("data").Select
Set sRng = Sheets("data").Range("f2")
sRng.Select
Do
    ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Value)
Set endsRng = ActiveCell.Offset(-1, 0)

'lets set the total range of the input data as Rng
Set Rng = Sheets("data").Range(sRng.Address & ":" & endsRng.Address)

For Each row In Rng.Rows
    'this is an attempt at being flexible
    If row.Offset(0, 2).Value Like "*1,1-Dichloroethene*" Then
        row.Offset(0, 2).Value = "1,1-Dichloroethylene"
    ElseIf row.Offset(0, 2).Value Like "*cis-1,2-Dichloroethene*" Then
        row.Offset(0, 2).Value = "cis-1,2-Dichloroethylene"
    ElseIf row.Offset(0, 2).Value Like "*Methylene chloride*" Then
        row.Offset(0, 2).Value = "Dichloromethane"
    ElseIf row.Offset(0, 2).Value Like "*Cyanide*" Then
        row.Offset(0, 2).Value = "Free Cyanide"
    ElseIf row.Offset(0, 2).Value Like "*Chlorobenzene*" Then
        row.Offset(0, 2).Value = "Monochlorobenzene"
    ElseIf row.Offset(0, 2).Value Like "*1,4-Dichlorobenzene*" Then
        row.Offset(0, 2).Value = "para-Dichlorobenzene"
    ElseIf row.Offset(0, 2).Value Like "*Tetrachloroethene*" Then
        row.Offset(0, 2).Value = "Tetrachloroethylene"
    ElseIf row.Offset(0, 2).Value Like "*Antimony*" Then
        row.Offset(0, 2).Value = "Total Antimony"
    ElseIf row.Offset(0, 2).Value Like "*Fluoride*" Then
        row.Offset(0, 2).Value = "Total Fluoride"
    ElseIf row.Offset(0, 2).Value Like "*Arsenic*" Then
        row.Offset(0, 2).Value = "Total Arsenic"
    ElseIf row.Offset(0, 2).Value Like "*Barium*" Then
        row.Offset(0, 2).Value = "Total Barium"
    ElseIf row.Offset(0, 2).Value Like "*Beryllium*" Then
        row.Offset(0, 2).Value = "Total Beryllium"
    ElseIf row.Offset(0, 2).Value Like "*Cadmium*" Then
        row.Offset(0, 2).Value = "Total Cadmium"
    ElseIf row.Offset(0, 2).Value Like "*Chromium*" Then
        row.Offset(0, 2).Value = "Total Chromium"
    ElseIf row.Offset(0, 2).Value Like "*Lead*" Then
        row.Offset(0, 2).Value = "Total Lead (as Pb)"
    ElseIf row.Offset(0, 2).Value Like "*Nickel*" Then
        row.Offset(0, 2).Value = "Total Nickel"
    ElseIf row.Offset(0, 2).Value Like "*Selenium*" Then
        row.Offset(0, 2).Value = "Total Selenium (Se)"
    ElseIf row.Offset(0, 2).Value Like "*Thallium*" Then
        row.Offset(0, 2).Value = "Total Thallium"
    ElseIf row.Offset(0, 2).Value Like "*Mercury*" Then
        row.Offset(0, 2).Value = "Total Mercury as Hg"
    ElseIf row.Offset(0, 2).Value Like "*Nitrogen, Total*" Then
        row.Offset(0, 2).Value = "Total Nitrogen"
    ElseIf row.Offset(0, 2).Value Like "*Xylenes, Total*" Then
        row.Offset(0, 2).Value = "Total Xylenes"
    ElseIf row.Offset(0, 2).Value Like "*trans-1,2-Dichloroethene*" Then
        row.Offset(0, 2).Value = "trans-1,2-Dichloroethylene"
    ElseIf row.Offset(0, 2).Value Like "*Trichloroethene*" Then
        row.Offset(0, 2).Value = "Trichloroethylene"
    ElseIf row.Offset(0, 2).Value Like "*TTHMs*" Then
        row.Offset(0, 2).Value = "Trihalomethanes (TTHM)"
    ElseIf row.Offset(0, 2).Value Like "*Vinyl chloride*" Then
        row.Offset(0, 2).Value = "Vinyl Chloride"
    ElseIf row.Offset(0, 2).Value Like "*Total Coliform*" Then
        row.Offset(0, 2).Value = "Total Coliform"
    ElseIf row.Offset(0, 2).Value Like "*1,2-Dichlorobenzene*" Then
        row.Offset(0, 2).Value = "o-Dichlorobenzene"
    ElseIf row.Offset(0, 2).Value Like "*E*Coli" Then
        row.Offset(0, 2).Value = "Fecal Coliform"
    End If
Next row

'lets get the last row of the unique sample dates on the output sheet
Sheets("output").Select
Set sData = Sheets("output").Range("b2")
sData.Select
Do
    ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Value)
Set endsDate = ActiveCell.Offset(-1, 0)

'lets set the total range of the unique sample dates on the output sheet
Set totalrng = Range(sData.Address & ":" & endsDate.Address)

For i = 2 To (totalrng.Count + 1)
    For j = 3 To 77
        datad = Cells(i, 2).Value
        datav = Cells(1, j).Value
        For Each row In Rng.Rows
            If (row.Value = datad And row.Offset(0, 2).Value = datav) Then
                finalr = row.Offset(0, 3).Value
                finald = row.Offset(0, 1).Value
                Exit For
            End If
        Next row
        If (finalr = "--" And finald = "--") Then
            Cells(i, j).Value = ""
            Cells(i, j + 1).Value = ""
        Else
            Cells(i, j).Value = finalr
            Cells(i, j + 1).Value = finald
        End If
        'lets clear the variables for the next iteration
        finalr = "--"
        finald = "--"
        'here we skip the analyze date col
        j = j + 1
    Next j
Next i

End Sub

Answer 1

This should work, assuming your data is in the first 2 columns. It ouputs the result in columns 4 and 5.

Public Sub getMax()

    Dim data As Variant
    Dim dict As Variant
    Dim d As Variant
    Dim i As Long

    data = UsedRange
    Set dict = CreateObject("Scripting.Dictionary")

    For i = LBound(data, 1) + 1 To UBound(data, 1) 'skips the first line
        If dict.exists(data(i, 1)) Then
            If dict(data(i, 1)) < data(i, 2) Then
                dict(data(i, 1)) = data(i, 2)
            End If
        Else
            dict.Add data(i, 1), data(i, 2)
        End If
    Next i

    ReDim data(1 To dict.Count, 1 To 2) As Variant

    i = 1
    For Each d In dict
        data(i, 1) = d
        data(i, 2) = dict(d)
        i = i + 1
    Next d

    Cells(1, 4).Resize(UBound(data, 1), UBound(data, 2)) = data

End Sub

Answer 2

VBA would be OK, filling an array with unique values, then looping over the array and selecting from the entire range, or a function would work also.

There is no need for VBA or a formula :) You can use the Pivot Table. See the snapshot below.

HTH

Sid