Question

我正在使用三个工作表： “门”是必须符合标准的“门”，如果满足标准，它将取消一些值，并将数据转移到的“生产计划”。

所以标准是“门”上的每一行都检查日期是否等于或大于今天的日期。如果是那么来自特定列的数据＆amp;然后将纸张从第24行转移到“生产计划表”中。

数据正在正确传输，而不是只从“门”中取出最后一行，而不是符合条件的所有行。我该如何解决？

Private Sub Worksheet_Initialize()
   Dim SourceJ As Worksheet, SourceD As Worksheet, Target As Worksheet
   Set SourceJ = Worksheets("Jobs")
   Set SourceD = Worksheets("Doors")
   Set Target = Worksheets("Production Schedule")
   Dim LR As Long
   Dim r As Long
   LR = SourceD.Range("A" & SourceD.Rows.Count).End(xlUp).row
   Dim tLR As Long
   Dim tr As Long
   tLR = Target.Range("A" & Target.Rows.Count).End(xlUp).row + 1
     For r = 1 To LR
     If SourceD.Cells(r, 6).Value >= Date Then
        For tr = 24 To tLR
         Target.Cells(tr, 1).Value = SourceD.Cells(r, 5).Value
         Target.Cells(tr, 5).Value = SourceD.Cells(r, 4).Value
         Target.Cells(tr, 6).Value = SourceD.Cells(r, 3).Value
        Next
    End If
  Next
End Sub

提前感谢您的帮助。

Answer 1

对于tr的每次迭代，您正在复制到相同的r行。你的意思是使用＆＃34;第24行和第34行;作为偏移？例如，

For r = 2 To LR
    If SourceD.Cells(r, 6).Value >= Date Then
        For tr = 24 To tLR
            Target.Cells((tLR - 24 + 1) * r + tr - 24, 1).Value = SourceD.Cells(r, 5).Value
            Target.Cells((tLR - 24 + 1) * r + tr - 24, 5).Value = SourceD.Cells(r, 4).Value
            Target.Cells((tLR - 24 + 1) * r + tr - 24, 6).Value = SourceD.Cells(r, 3).Value
        Next
    End If
Next

这样可以保证每行r都有自己的一组生产计划行。

Answer 2

tr的值是完全相同的时间。如果我理解您的期望，下面的代码应该会更好：

Private Sub Worksheet_Initialize()
    Dim SourceJ As Worksheet, SourceD As Worksheet, Target As Worksheet
    Dim LR As Long
    Dim r As Long
    Dim tLR As Long
    Dim tr As Long

    Set SourceJ = Worksheets("Jobs")
    Set SourceD = Worksheets("Doors")
    Set Target = Worksheets("Production Schedule")
    LR = SourceD.Range("A" & SourceD.Rows.Count).End(xlUp).Row

    tLR = Target.Range("A" & Target.Rows.Count).End(xlUp).Row + 1
    tr = 24
    For r = 1 To LR
        If SourceD.Cells(r, 6).Value >= Date Then
            Target.Cells(tr, 1).Value = SourceD.Cells(r, 5).Value
            Target.Cells(tr, 5).Value = SourceD.Cells(r, 4).Value
            Target.Cells(tr, 6).Value = SourceD.Cells(r, 3).Value
            tr = tr + 1
        End If
    Next
Next
End Sub

即使其他行符合Criteria，我的VBA也只传输最后一行数据

2 个答案: