VBA循环单元格并根据条件复制

Question

[将A2复制到E2直到表格行尾，检查单元格是否在同一个月内](https://i.stack.imgur.com/Q7YAx.png)

你好，

我想通过定义一个变量并计算表的最后一行来循环遍历表中的行，从 A2 列到 E2 列到 A3 列到 E3 列...直到 Ai 到 Ei 表的末尾。

作为第二步，我想将单元格复制到另一个工作表中并填写相应的月份。

[Desired Output--> 会复制数据并返回对应月份的另一个sheet] (https://i.stack.imgur.com/zhgYh.png)

相反，我将数据类型更改为数字格式并设置了两个循环条件。

例如。 1/1/2017 更改为 42736

28/2/2017 更改为 42794

Sub Mike_Copy_cell()

Dim i As Long 'for looping inside each cell
Dim myvalue As Variant
Dim Lastrow As Long
Const StartRow As Byte = 2
Dim LastMonth As Long

("Mike Filter").Select
Lastrow = Range("A" & StartRow).End(xlDown).Row
For i = StartRow To Lastrow
myvalue = Range("H" & i).Value
If myvalue \< Sheets("Automate Report").Range("A" & i).Value \_
'First data Feb Data 42794 \< Jan Category 42736
Then Sheets("Automate Report").Range("B" & i).Value = ""
'leave the cells in blanks and loop through next cell

        If myvalue > Sheets("Automate Report").Range("A" & i).Value _
       'First data Feb Data 42794 > Jan Category 42736 
            Then Range("A" & i, "E" & i).Copy Sheets("Automate Report").Range("B" & i, "F" & i)
       'Copy the cells into corresponding category 

Next i

End sub()

在我的输出中，它能够遍历并复制所有单元格。但是，我想知道满足第一个条件时 VBA 输出不能留下任何空白单元格的原因？

**如果不是数据不在同一个月内或者在我的情况下低于我设置的标准，我希望表格中有一些空白。 **

The output of my code

If myvalue < Sheets("Automate Report").Range("A" & i).Value _ 然后 Sheets("Automate Report").Range("B" & i).Value = ""

如果您能指出我代码中的缺陷，将不胜感激。非常感谢。

最好的祝福， 肯尼斯

Answer 1

我会尽力帮忙。但在此之前，我可以给你两个可能对你有帮助的建议吗？

首先，对我来说，找到最后一行的最佳方法是，不要使用第一行的 xldown，而是使用 excel 最后一行的 xlup。这样，如果任何中间行有空白，代码仍会为您提供最后一行的值。

其次，我发现在该引用中使用变量时，使用“范围”方法引用任何单元格有时可能会限制您。我认为使用“单元格（行，列）”方法更有用。

为什么不试试这个？

Lastrow = Cells(Rows.Count, 1).End(xlUp).Row

很抱歉提出这些建议，只是我希望有人早点教我这些建议。

回到主题，我认为问题在于你如何构造“if”语句。请允许我稍微更改一下：

Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = StartRow To Lastrow
  myvalue = cells(i, 8).Value
  'if myvalue date is equal or previous to the one found in Ai...
  If myvalue <= Sheets("Automate Report").cells(i, 1).Value then
    Sheets("Automate Report").cells(i, 2).Value = ""
  'but if myvalue is later than Ai...
  else
    sheets("Automate Report").select
    range(cells(i, 1), cells(i, 5).select
    selection.copy
    cells(i, 2).select
    activesheet.paste
  end if
Next i

希望这可以帮助。最好的祝福，

麦克风

Answer 2

我不确定您的代码在做什么，但考虑使用行号数组（12），每个月一个。将行复制到相应的月份并增加该月份的行号。例如 ;

Option Explicit
Sub Mike_Copy_cell()

    Const LINES_MTH = 5 ' lines per month

    Dim wb As Workbook
    Dim wsIn As Worksheet, wsOut As Worksheet
    Dim lastrow As Long, rIn As Long, rOut(12) As Long
    Dim uid As String, prevuid As String
    Dim dAVD As Date, m As Long, n As Long
    
    Set wb = ThisWorkbook
    Set wsIn = wb.Sheets("Mike Filter")
    Set wsOut = wb.Sheets("Automate Report")
    
    ' space out months
    For n = 0 To 11
        rOut(n + 1) = 2 + n * LINES_MTH
        wsOut.Cells(rOut(n + 1), "A").Value2 = MonthName(n + 1)
    Next
  
    n = 0
    With wsIn
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For rIn = 2 To lastrow
        
            dAVD = .Cells(rIn, "D")
            ' create a unique ID to skip duplicates
            uid = .Cells(rIn, "A") & Format(.Cells(rIn, "D"), "YYYY-MM-DD")
            If uid <> prevuid Then
                m = Month(dAVD)
                .Cells(rIn, "A").Resize(, 5).Copy wsOut.Cells(rOut(m), "B")
                rOut(m) = rOut(m) + 1
                n = n + 1
            End If
            prevuid = uid
            
        Next
    End With
    MsgBox n & " lines copied to " & wsOut.Name, vbInformation

End Sub