如果满足条件，则选择要复制并粘贴到另一个单元格的范围

Posted 2023-03-27

【中文标题】如果满足条件，则选择要复制并粘贴到另一个单元格的范围

【英文标题】：select a range to copy and paste in another cell if a condition is met

【发布时间】：2020-08-15 11:55:53

【问题描述】：

Dim word As Variant
Dim range As Variant


If cells(5, [6]) = "Bulk Density" Then
range = ("A3:K11")


For Each word In range
        If word = "Moisture Content" Then
            [M20] = word.Offset(0, 1)
            Exit For
        End If
        Next
        End If
End Sub

您好，我正在尝试根据单元格 f5 选择范围。然后，如果在f5 中遇到该词，我想选择一个特定范围（A3:K11），我可以从中复制数据并将其移动到另一个单元格。例如，如果单元格 f5 包含“体积密度”，那么我想复制单元格范围内的水分含量值（并不总是在同一行中），然后将该值粘贴到 M20 中。当我自动放入范围时，值的复制和粘贴有效，但是当我希望它选择范围本身时，单词变量始终为空，我不知道为什么。任何帮助将不胜感激，感谢 max

【问题讨论】：

你好，很难确定逻辑，没有理由循环遍历 A3:K11，因为这个词只会在 F 列中...你能过滤 F 列的体积密度和水分吗内容，然后循环过滤单元格？ ，我假设您想为所有组执行此操作。

嗨 davesexcel 是的，那是正确的，那么在这种情况下我应该确定范围为 F3:F11 吗？

是的，在您的描述中，您似乎正在尝试查找“水分含量”一词并在其旁边获取结果。如果您对范围进行硬编码，则只需 =vlookup()。

嗨，戴夫，感谢您的回复。我正在尝试编写一个 vba，因为我每天必须进行大约 400 次测试。我的逻辑是我可以过滤 csvs 并获取行中的信息，我可以将这些信息串到我的主跟踪表中。我不断得到一个需要的对象 [M20] = word.Offset(0, 1) 我不确定为什么。我想让这部分代码工作，因为我只需要为所有其他部分复制它，然后清除范围的内容，然后循环代码，以节省时间。

【参考方案1】：

一种查找

第一个 Sub 处理您的直接案例 (Bulk Density ...)。 如果要将相同的逻辑应用于其他“属性”，请编辑 第三个 Sub（调用第二个 Sub）以满足您的需求。

守则

Option Explicit

Sub writeValueConst()

    Const CheckString As String = "Bulk Density"
    Const CheckCellAddress As String = "F6"
    Const Searchstring As String = "Moisture Content"
    Const SearchRangeAddress As String = "F3:F11"
    Const ColumnOffset As Long = 1
    Const WriteCellAddress As String = "M20"
    
    Dim cel As Range
    If Range(CheckCellAddress).Value = CheckString Then
        For Each cel In Range(SearchRangeAddress).Cells
            If cel.Value = Searchstring Then
                Range(WriteCellAddress).Value _
                  = cel.Offset(0, ColumnOffset).Value
                Exit For
            End If
        Next cel
    End If

End Sub

Sub writeValue(ByVal CheckString As String, _
               ByVal CheckCellAddress As String, _
               ByVal Searchstring As String, _
               ByVal SearchRangeAddress As String, _
               ByVal WriteCellAddress As String, _
               Optional ByVal ColumnOffset As Long = 1)

    Dim cel As Range
    If Range(CheckCellAddress).Value = CheckString Then
        For Each cel In Range(SearchRangeAddress).Cells
            If cel.Value = Searchstring Then
                Range(WriteCellAddress).Value _
                  = cel.Offset(0, ColumnOffset).Value
                Exit For
            End If
        Next cel
    End If

End Sub

Sub writeDensities()
    Dim Series(1) As Variant
    
    ' If you add or remove, you have to adjust the previous number after Series.
    Series(0) = Array("Bulk Density", "F6", "Moisture Content", _
                      "F3:F11", "M20", 1)
    Series(1) = Array("Dry Density", "F8", "Degree of Compaction", _
                      "F3:F11", "M21", 1)
    
    Dim j As Long
    For j = 0 To UBound(Series)
        writeValue Series(j)(0), Series(j)(1), Series(j)(2), _
                   Series(j)(3), Series(j)(4), Series(j)(5)
    Next j

End Sub