excel - установить / повторить динамический диапазон

Question

РЕДАКТИРОВАТЬ .... Босс бросил мне кривую;

Я хотел бы вытащить значения для нескольких диапазонов данных в Excel.Диапазоны определяются датой.

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

, поэтому для вышеизложенного я бы хотел получить переменную, aDate и результат каждой уникальной комбинации sDate-variable.У меня есть набор выходных данных .xls, которые необходимо заполнить, в следующем формате:

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 будет в порядке, заполняя массив уникальными значениями, затем циклически перебирая массив и выбирая из всегодиапазон, затем извлечение значений

Я потерян

спасибо за любую помощь!

Редактировать

Вот мое решение;может быть не элегантно, но функционально

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

VBA будет в порядке, заполнение массива уникальными значениями, затем цикл по массиву и выбор из всего диапазона, или функция также будет работать.

Нет необходимости в VBA или формуле :) Вы можете использовать сводную таблицу. Смотрите снимок ниже.

НТН

Sid

Answer 2

Это должно работать, предполагая, что ваши данные находятся в первых 2 столбцах.Он выводит результат в столбцах 4 и 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