Excel VBA：根据另一张工作表上某列范围内的值更新一行中的单元格

Question

我正在尝试搜索工作表 1 上的 D 列并获取特定范围 (10-100) 内的值，并让它们连续填充到工作表 2 中（例如：第 20 行）并跳过不在范围内的值在范围内而不在结果中留下间隙/空白单元格。但是，最新的值会覆盖旧的单元格值（因此，工作表 2 上的值不是 10、11、12，而是 12、12、12）。此外，我无法弄清楚如何让值填充到单行中（如行 C3:Z3），所以它们一直填充到一列中。

方法一：

Sub SearchLoop

Range("Sheet1!D").Select

Do Until IsEmpty(ActiveCell)
If ActiveCell.Value > 10 And ActiveCell.Value < 100 
Then Range("Sheet2!A:A").Value = Selection.Value
ActiveCell.Offset(1, 0).Select

Loop
End Sub

方法二：

Sub SearchLoop

Dim cell As Range

For Each cell in Sheets("Sheet1").Range("D:D")
If cell.Value > 10 And cell.Value < 100 Then
Range("Sheet2!A").Value = cell.Value

End If
Next Cell

End Sub 

Answer 1

试试

Sub CopyValuesInRange()
    
    Dim lastRow As Long
    Dim srcRange As Range
    Dim cell As Range
    Dim dstColumn As Long
    
    
    ' Find the last row in column D of Sheet1
    lastRow = Worksheets("Sheet1").Cells(ws1.Rows.Count, "D").End(xlUp).Row
    
    ' Set the source range in column D of Sheet1
    Set srcRange = Worksheets("Sheet1").Range("D1:D" & lastRow)
    
    ' Loop through each cell in the source range
    For Each cell In srcRange
        If cell.Value > 10 And cell.Value < 100 Then
            Worksheets("Sheet2").Range("A20").Offset(0, dstColumn).Value = cell.Value
            ' Increment the destination column
            dstColumn = dstColumn + 1
        End If
    Next cell
End Sub