时间戳

首页 > 解决方案 > 循环遍历范围，如果单元格包含值，则复制到列中的下一个空单元格

vba - 循环遍历范围，如果单元格包含值，则复制到列中的下一个空单元格

问题描述

我很难找到任何有我疑问的东西。我可以找到我需要的不同部分，但无法将它们放在一起。

我需要做的是查看一个设定的范围，如果值在 0.001 和 0.26 之间，然后复制单元格并粘贴到列（“DA”）中的下一个空单元格中，还从找到值的同一行复制单元格但复制从列（“C”）并粘贴到列（“DB”）旁边。

我知道我必须使用 If 语句循环，并且当它找到与条件匹配时必须偏移单元格。但我不能把它放在一起。

我已经尝试了以下代码。

Sub COPYcell()
    Dim Last As Long
    Dim i As Long, unionRng As Range

    Last = 61
    Dim lastrow As Long
    lastrow = Sheets("Sheet1").Range("DA100").End(xlUp).Row

    For i = 5 To Last
        If (.Cells(i, "J").Value) >= 0.01 And (.Cells(i, "J").Value) <= 0.26 Then
          
           'Cells(i, "DA").Value = Cells(i, "J").Value
           Range(i, "J").Copy = Range("DA" & lastrow)
           Cells(i, "J").Offset(, -8) = Range("DB" & lastrow)
           Range("DC" & lastrow) = "July"
                         
         End If
    Next i                          
End Sub

标签： vbaexcel

解决方案

尝试以下操作：

Option Explicit    
Public Sub COPYcell()
    Dim last As Long, sht1 As Worksheet
    Dim i As Long, unionRng As Range, lastrow As Long, nextRow
    Application.ScreenUpdating = False
    Set sht1 = Worksheets("Sheet1")
    last = 61

    With sht1
        lastrow = .Cells(.Rows.Count, "DA").End(xlUp).Row
        nextRow = IIf(lastrow = 1, 1, lastrow + 1)
        For i = 5 To last
            If .Cells(i, "J").Value >= 0.01 And .Cells(i, "J").Value <= 0.26 Then '1%=26%
                If Not unionRng Is Nothing Then
                    Set unionRng = Union(unionRng, .Cells(i, "J"))
                Else
                    Set unionRng = .Cells(i, "J")
                End If
            End If
        Next i

        If Not unionRng Is Nothing Then
            unionRng.Copy .Range("DA" & nextRow)
            unionRng.Offset(0, -7).Copy .Range("DB" & nextRow)
        End If
    End With
    Application.ScreenUpdating = False
End Sub

推荐阅读