我很难找到任何有我疑问的东西。我可以找到所需的不同部件,但无法将它们放在一起。
我需要做的是查看设定范围,如果值在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
结束子
答案 0 :(得分:0)
您需要循环范围和内部循环,以检查单元格是否不为空,复制单元格值,然后粘贴到下一个空单元格中。
示例代码:
Sub Func ()
Dim rng As Range, cell As Range
Set rng = Range("A1:A3")
For Each cell In rng
If (IsEmpty(cell.value))
Cell.paste()
Else
cell.copy()
End if
Next cell
End sub
该代码未经过测试,因为我是在手机上键入的。
答案 1 :(得分:0)
您当前的代码给我有关范围对象的错误。我保持简单,并将单元格值分配给单元格值。另外,我不确定您是指.01还是.001。您可能会摆弄。我看到的问题是,当您找到更多匹配项时,您希望lastrow上升,因此您正在写的是现在的最后一行,而不是以前的内容。您还粘贴了一些未使用的变量,所以我简化了。这是结果。
Sub COPYCell()
Dim Last As Long
Dim i As Long
Last = 61
Dim lastrow As Long
lastrow = Sheets("Sheet1").Range("DA100").End(xlUp).Row + 1
For i = 5 To Last
If (Cells(i, "J").Value <= 0.26) And (Cells(i, "J").Value >= 0.001) Then
Cells(lastrow, "DA").Value = Cells(i, "J").Value
Cells(lastrow, "DB").Value = Cells(i, "C").Value
Cells(lastrow, "DC").Value = "July"
lastrow = lastrow + 1
End If
Next i
End Sub
EDIT每个评论在lastRow上添加了+1。我已经测试过我还没有的地方。
答案 2 :(得分:0)
尝试以下操作:
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