Excel VBA根据条件复制数据和插入行

我正在进行一项任务，在该任务中，我以如下特定格式获取个人日历：

表1 A栏-日期 B栏-位置 C栏-出发日期（文本格式2017年1月10日上午10:00） D列-到达日期（文本格式2017年1月10日上午10:00） E列-新位置 F栏-注释

我需要执行的任务如下：

将Sheet1数据复制到Sheet2

复制数据时，我需要根据以下条件插入行

如果C列出发日期和D列到达日期在同一天，则插入一个新行，其值如下：

A列-与上一行相同的日期 B列-E列的新位置，如上一行所示 C列-空白 D列-空白 E列-空白 F列-空白

如果C列出发日期和D列到达日期是不同的日期，则无需插入行，遵循与Sheet1中数据相同的顺序

我使用了以下代码，但面临以下两个问题：

-此代码仅适用于表1。你能帮我把这个添加到Sheet2上吗？这样我就可以得到Sheet1和Sheet2的原始数据以及我需要的结果？ -此外，下面的代码使用文本“INSERT”作为标准。我想将其改为C列和D列，如果日期相同，则在日期下方添加新行。（请记住，C列和D列有文本格式的日期，因此我们可能需要使用我的朋友建议的左函数）

Private子命令按钮1\u单击（）
将wksData设置为工作表
暗淡的lngLastRow和长的LNGIX一样长_
只要_
只要_
只要_
LngDestinationCountycol，只要_
只要_
只要_
只要
Dim varRowNum作为变量
Dim ColrowNumForInsert作为集合
设置colRowNumsForInsert=新集合
“在前面设置引用
lngDateCol=1
lnglocationcountycol=2
lngDepartureDateCol=3
lngArrivalDateCol=4
LNGDestinationCountycol=5
lngNotesCol=6
设置wksData=此工作簿。工作表（“表1”）
lngLastRow=最后发生率（wksData）
'向后循环数据范围，跟踪一行需要位于集合中的每种情况
与wksData
对于LNGIX=lngLastRow到2步骤-1
'如果Notes Column=“INSERT”，那么我们还需要'注意该行号，以便最终可以在那里添加新行
如果.Cells（lngIdx，lngNotesCol）=“插入”，则
colRowNumsForInsert.Add项：=lngIdx，项：=CStr（lngIdx）
如果结束
下一个lngIdx
'现在我们只需要在需要的地方添加行，并应用正确的值
'循环遍历集合中的行号，这些行号方便地按相反顺序排列（因为添加行将更改范围中的行号，这使得正向循环非常困难）
对于colRowNumsForInsert中的每个varRowNum
'首先，插入新行，将其下方的所有内容向下移动
.Range（“A”&varRowNum）.Offset（1）.EntireRow.Insert Shift:=xlDown
'写入日期（相同的日期）
.Cells（varRowNum+1，lngDateCol）=.Cells（varRowNum，lngDateCol）
'写入新位置（即上行中的新位置）
.Cells（varRowNum+1，lngLocationCountryCol）=.Cells（varRowNum，lngDestinationCountryCol）
.Cells（varRowNum，lngNotesCol）=“”
下一个varRowNum
以
'让用户知道脚本已完成
MsgBox“完成！”
端接头
'输入：工作表，我们将搜索以查找最后一行的工作表
'输出：长，最后占用的行
'特殊情况：如果工作表为空，则返回1
公共函数LastOccupiedum（工作表形式）长度为
随着时间的推移，液化天然气变得暗淡
如果Application.WorksheetFunction.CountA（Sheet.Cells）为0，则
用床单
lng=.Cells.Find（What:=“*”_
之后：=.范围（“A1”）_
看：=xlPart_
LookIn:=xl公式_
搜索顺序：=xlByRows_
搜索方向：=xlPrevious_
MatchCase:=False）。行
以
其他的
液化天然气=1
如果结束
Lastoccupieum=液化天然气
端函数

如果我能很好地理解您的需求，这应该可以：

Sub Santhosh()
    Dim lastRow, i As Long

    Sheets(2).Range("A1:E1").Value = Sheets(1).Range("A1:E1").Value

    lastRow = Sheets(1).Cells(Sheets(1).Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRow
        If Left(Sheets(1).Range("C" & i).Value, 11) = Left(Sheets(1).Range("D" & i).Value, 11) Then
            Sheets(2).Range("A" & i).Value = Sheets(1).Range("A" & i).Value
            Sheets(2).Range("B" & i).Value = Sheets(1).Range("E" & i).Value
        Else
            Sheets(2).Range("A" & i & ":E" & i).Value = Sheets(1).Range("A" & i & ":E" & i).Value
        End If
    Next
End Sub

---

到目前为止，您尝试/研究了哪些内容，哪些内容不起作用？您的帖子将显示您的现有代码，以及您收到的错误消息。感谢您的回复。除了vba将数据从Sheet1复制到Sheet2，然后根据特定单元格中的值插入行之外，我还没有找到任何特别的内容。我找不到的是一个可以读取我上面提到的标准的代码——读取文本格式的C列和D列，如果日期相同，则插入一行。如果日期现在相同，那么不要插入行，按照顺序操作。问题是，如果你a）尝试，b）分享你所尝试的，你会得到更好的支持和建议。现在，看起来你只是希望有人为你写代码。。。这不是这个网站的目的。嗨，斯蒂法诺，谢谢你的回复，我相信我走的方向是正确的。通过使用该条件，未插入新行。如果我之前不清楚，我将再次添加任务。步骤1-将数据从Sheet1复制到Sheet2（您的代码工作正常）步骤2-如果C列出发日期和D列到达日期在同一天，则在满足条件的日期后插入新行。新行将具有与上述相同的日期和E列中的新位置国家/地区。对于不满足条件的日期，保留相同的日期和国家/地区。换句话说，可能需要的编辑为1。如果在特定日期满足条件，则插入一行，并将新位置（列E值）添加到新行和2。任何不符合条件的日期都应保留在同一位置。我已使用我能够创建的代码编辑了我的原始问题。

Sub Santhosh()
    Dim lastRow, i As Long

    Sheets(2).Range("A1:E1").Value = Sheets(1).Range("A1:E1").Value

    lastRow = Sheets(1).Cells(Sheets(1).Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRow
        If Left(Sheets(1).Range("C" & i).Value, 11) = Left(Sheets(1).Range("D" & i).Value, 11) Then
            Sheets(2).Range("A" & i).Value = Sheets(1).Range("A" & i).Value
            Sheets(2).Range("B" & i).Value = Sheets(1).Range("E" & i).Value
        Else
            Sheets(2).Range("A" & i & ":E" & i).Value = Sheets(1).Range("A" & i & ":E" & i).Value
        End If
    Next
End Sub