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 

所以，針對上述情況，我想拉變量，每個獨特SDATE變量組合的ADATE &結果。我有一組輸出的.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將是OK，填充陣列具有唯一值，然後循環陣列上方，並從整個範圍內選擇，然後提取值

我迷路了

感謝您的幫助！

編輯

這裏是我的解決方案;可能不夠高雅，但它的功能

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將是OK，填充具有唯一值的陣列，然後循環陣列上方，並從整個範圍內選擇，或者一個功能也可以工作。

沒有必要對VBA或公式:)你可以使用數據透視表。見下面的快照。

HTH

希德

Answer 2

這應該工作，假設您的數據在前2列。它的OUPUTS結果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