最新の日付とコピーの深さの列を新しいシートに置き換えます。

Question

ユーザーがデータをインポートしたExcelブックがあります。イメージを参照してください。

最新の日付を見つけて、対応する日付（最新）の奥行値を「隠し」という別のシートにコピーしたいのですが、私の問題は、インポートされるデータセットの数は、データはユーザーのインポートを設定するため、動的です。同様に読書日が配置されているセルは、深さがありますどのように多くの値に応じて、動的である（文句を言わない、常に17.5こと）

ここではいくつかのコードである私は/

Sub Copy_Depth1() 

Dim i As Integer 
Dim j As Integer 

j = 1 
i = 1 

Do Until j = Sheets("Hidden").Range("B2").Value 'I count how many times data has been imported to this sheet in this cell in this specific case j is 3 

With Sheets("Data Importation Sheet") 
Set Cell2 = .Columns(i).Find(What:="Reading Date:", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlDown, MatchCase:=False, SearchFormat:=False) 
Set Cell3 = Cell2.Offset(1, 0) 
Debug.Print Cell3.FormulaR1C1 
End With 

i = i + 7 
j = j + 1 

Loop 

End Sub 

で任意のヒントを働いています助けが大いに評価されるだろう！前もって感謝します！

Answer 1

Sub Copy_depth_Updated() 
Dim dataWS As Worksheet, hiddenWS As Worksheet 
Dim tempDate As String, mostRecentDate As String 
Dim datesRng As Range, recentCol As Range, headerRng As Range, dateRow As Range, cel As Range 

Set dataWS = Worksheets("Data Information Sheet") 
Set hiddenWS = Worksheets("Hidden") 

Set headerRng = dataWS.Range(dataWS.Cells(1, 1), dataWS.Cells(1, dataWS.Cells(1, Columns.Count).End(xlToLeft).Column)) 
'headerRng.Select 

For Each cel In headerRng 
    If cel.Value = "Depth" Then 
     Set dateRow = cel.EntireColumn.Find(what:="Reading Date:", LookIn:=xlValues, lookat:=xlPart) 
     Set datesRng = dataWS.Cells(dateRow.Row + 1, dateRow.Column) 
     'datesRng.Select 

     ' Find the most recent date 
     tempDate = Left(datesRng, 10) 
     If tempDate > mostRecentDate Then 
      mostRecentDate = tempDate 
      Set recentCol = datesRng 
     End If 
    End If 
Next cel 

Dim copyRng As Range 
With dataWS 
    Set copyRng = .Range(.Cells(2, recentCol.Column), .Cells(.Cells(2, recentCol.Column).End(xlDown).Row, recentCol.Column)) 
End With 

hiddenWS.Range(hiddenWS.Cells(2, 1), hiddenWS.Cells(copyRng.Rows(copyRng.Rows.Count).Row, 1)).Value = copyRng.Value 

End Sub 

少し冗長ですが、動作するはずです。それは "Depth"で列を探し、その列の日付を見ます。これにより、グループ内の列を追加/削除できるようになります。

調整が必要な場合はお知らせください。