首页 > 解决方案 > 将数据复制到正确的行

问题描述

我正在尝试从 Excel 上的不同工作表中读取信息列表,如果截止日期匹配,则该人的所有详细信息都将粘贴到新工作表上的行中。

但是,我尝试遍历列表中的所有人员,但说此人在原始列表中排名第 4,则该人的信息将被正确粘贴,但 4 位向下而不是顶部(如图所示的示例)。

我不太确定如何修复它,以便每个具有匹配截止日期的人都可以按顺序正确复制到正确的位置,而不会被覆盖。

在此处输入图像描述

Sub DepotsDue()
Dim i As Long


Worksheets("Depots Due Weekly").Range("A5:F150").ClearContents

For i = 1 To 150


 If Worksheets("Depots Due Weekly").Cells(1, "B").Value = Worksheets("Weekly").Cells(1 + i, "E").Value Then
 Worksheets("Depots Due Weekly").Cells(4 + i, "A").Value = Worksheets("Weekly").Cells(1 + i, "A").Value
 Worksheets("Depots Due Weekly").Cells(4 + i, "B").Value = Worksheets("Weekly").Cells(1 + i, "B").Value
 Worksheets("Depots Due Weekly").Cells(4 + i, "C").Value = Worksheets("Weekly").Cells(1 + i, "C").Value
 Worksheets("Depots Due Weekly").Cells(4 + i, "D").Value = Worksheets("Weekly").Cells(1 + i, "D").Value
 End If

Next i

End Sub

标签: excelvba

解决方案


您将不得不使用两个计数器。一张用于原表,一张用于新表。现在您逐步浏览原始表,并且每当您在第二个表中插入一行时,增加第二个计数器:

Sub DepotsDue()
Dim i As Long
Dim newCounter as long

Worksheets("Depots Due Weekly").Range("A5:F150").ClearContents

For i = 1 To 150

  If Worksheets("Depots Due Weekly").Cells(1, "B").Value = Worksheets("Weekly").Cells(1 + i, "E").Value Then
    Worksheets("Depots Due Weekly").Cells(4 + newCounter , "A").Value = Worksheets("Weekly").Cells(1 + i, "A").Value
    Worksheets("Depots Due Weekly").Cells(4 + newCounter , "B").Value = Worksheets("Weekly").Cells(1 + i, "B").Value
    Worksheets("Depots Due Weekly").Cells(4 + newCounter , "C").Value = Worksheets("Weekly").Cells(1 + i, "C").Value
    Worksheets("Depots Due Weekly").Cells(4 + newCounter , "D").Value = Worksheets("Weekly").Cells(1 + i, "D").Value
    newCounter =newCounter + 1
  End If

Next i

End Sub

推荐阅读