excel - set/iterate dynamic range

Question

EDIT ....ボスは私にカーボールを投げた。

私は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であろう、アレイ上にループ全体の範囲から選択次いで、一意の値を持つ配列を充填し、値を抽出する??

私は迷子です。

ありがとうございました！

編集

ここに私のソリューションです。エレガントなこと、それはこれがあなたのデータは最初の2列にあると仮定すると、動作するはずの機能

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であろうouputsうまくいくでしょう。

VBAまたはあなたがピボットテーブルを使用することができます:)式のための必要はありません。以下のスナップショットを参照してください。

HTH

シド

助けを

Answer 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