select 如果滿足條件，則復制並粘貼到另一個單元格中的范圍

Question

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

嗨，我正在嘗試 select 基於單元格f5的范圍。 然后，如果在f5中遇到該詞，我想 select 一定范圍（ A3:K11 ），我可以從中復制數據並將其移動到另一個單元格。 例如，如果單元格f5包含“體積密度”，那么我想復制單元格范圍內的水分含量值（並不總是在同一行中），然后將該值粘貼到M20中。 當我自動放入范圍時，值的復制和粘貼有效，但是當我想要它 select 范圍本身時，單詞變量始終為空，我不知道為什么。 任何幫助將不勝感激，感謝max

Answer 1

一種查找

• 第一個子解決您的直接情況（ 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