根据最新的阅读日期VBA

Question

我正在使用excel工作簿，用户将文本文件导入“数据导入表”，导入的文本文件数量是动态的。见图。

所以这就是我需要发生的事情

1）需要找到最新的阅读日期（在本例中为2016年）

2）需要将最新阅读日期的深度值范围复制并粘贴到单独的工作表中（在此示例中，我希望复制并粘贴值1-17.5。

3）需要检查所有其他数据集是否包含相同范围的深度值。对于2014年，您可以看到它的深度从0.5到1.5.5。我希望能够在最新的阅读日期范围内复制数据，因此范围为1-17.5。

这是我的代码，用于查找最新的阅读日期并将这些深度复制到其他工作表。

Sub Copy_Depth()

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
Dim lRow As Long
Dim x As Double

Set dataws = Worksheets("Data Importation Sheet")
Set hiddenws = Worksheets("Hidden2")
Set calcws = Worksheets("Incre_Calc_A")

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
calcws.Range(calcws.Cells(2, 1), calcws.Cells(copyRng.Rows(copyRng.Rows.Count).Row, 1)).Value = copyRng.Value

Worksheets("Incre_Calc_A").Activate
lRow = Cells(Rows.Count, 1).End(xlUp).Row
x = Cells(lRow, 1).Value
Cells(lRow + 1, 1) = x + 0.5

End Sub

任何提示/帮助将不胜感激。我是VBA的新手，不知道如何比较深度范围！提前谢谢！

Answer 1

假设您的数据集与截图所示的数据集一样有条理，那么可以在Excel中完成大量处理。

下图显示了基于示例中显示的数据的可能方法。

该方法利用了每个数据集占据输入工作表的7列的事实。 =ADDRESS()函数用于构建看起来像单元格地址的文本字符串，并进一步操作这些字符串以创建看起来像范围地址的文本字符串。该方法还假设读取日期始终位于最后一行深度数据之后的第三行。

解决方案与您的问题略有不同，因为它确定了所有数据集中的常见深度值范围。对于问题中的示例，这与识别与最新阅读日期相关联的深度值相同。

采用这种方法，因为从问题中不清楚如果数据集的深度值从1.5开始（大于最近阅读日期的第一个值）或结束于17（所以小于最新阅读日期的最后一个值）。如果这些可能性永远不会发生，那么这种方法显然可以适应。

上图中显示的表格在其最后一列中是从数据导入表格中复制的范围的文本表示。一小段VBA可以读取此列，一次一个单元格，并使用该文本分配适当的范围对象，然后可以应用复制和粘贴方法。

回答

上面的图片可以设置为“帮助”工作表。如果“数据导入工作表”上始终存在相同数量的数据集，则设置此帮助程序表，以使表2中的行数等于此数据集数。如果数据集的数量是可变的，则设置帮助工作表，以便表2中的行数等于可能遇到的最大数据集数。在这种情况下，当导入的数据集数量少于此最大值时，表2中的某些行将不被使用，并且这些未使用的行将在某些列中包含无意义的值。

您的VBA程序应该被组织为读取帮助程序表cell D2中值的值，然后使用它来确定要使用其余VBA代码检查表2的行数。这将忽略未使用的行（如果有）。

如果您的VBA代码在帮助工作表的cell D2中标识了一个值，比如10，那么您将希望您的代码一次读取Q12:Q21范围内的10个值（所以一个循环）。这些单元格中的每一个都以字符串形式保存包含单个数据集值的范围，因此可以使用诸如

之类的代码将其分配给Range对象

Set datasetRng = Range(datasetStr)

其中datasetStr是从Q12:Q21中的单元格读取的文本字符串。

然后，仍然可以将datasetRng复制并粘贴到输出工作表中。

由于可以为每次数据导入重复使用相同的帮助程序工作表，因此您应该能够将其合并到自动化方案中。无需复制和粘贴公式向下行为每次导入创建不同的帮助程序，只需将相同的帮助程序模板应用于每个数据导入。

采用的方法尽可能多地使用Excel来确定有关导入数据集的相关信息，并在帮助程序工作表中汇总此信息。这意味着VBA可以限制为数据集上的复制/粘贴操作的自动化，并且可以从帮助工作表中读取信息，以确定要为每个数据集复制的内容。

当然可以在VBA中完成所有工作，但正如您所说，您对VBA 相当新，那么将平衡倾向于使用更少的VBA和更多Excel似乎是明智的。

顺便提一下，比较深度范围的问题实际上不是Excel或编程之一，而是分析之一 - 即查看一系列案例，找出每个案例需要发生的事情。 case，并将其提炼成一组处理规则（有些人称之为算法）。只有这样才能尝试实现这些处理规则（通过Excel公式或VBA代码）。我已经暗示我对问题的分析（找到所有数据集中的常见深度值范围），您应该能够跟踪我在Excel中如何实现这一点，以满足某些数据集可能包含深度值较小的情况比公共范围的最小值或大于其最大值（或可能两者）。

附加位结束

使用的公式如下表所示。