时间戳

首页 > 解决方案 > VBA 将符合条件的数据拆分为另一个 Excel 文件中的 2 个工作表

excel - VBA 将符合条件的数据拆分为另一个 Excel 文件中的 2 个工作表

问题描述

工作簿 1中已填满 H、I、J 或 K 列的行已准备好传输。

我想将准备好传输的行复制并粘贴到Workbook 2中的 2 个现有工作表（Alex 和 IMHD）中。

Workbook 2中的每个工作表都需要从Workbook 1复制不同的信息。我已经找出了 2 组不同的复制和粘贴代码。

但是，我找不到可以拆分数据的代码，这样一半执行第一个复制和粘贴代码（CopytoAlex），而另一半执行另一个复制和粘贴代码（CopytoIM）。

注意：请随时做出任何澄清。我已经尽力解释了。

Public Function CouriersTemplate()
Workbooks("Workbook 2.xlsb").Activate
Dim sourceColumn As Range, targetColumn As Range
Dim i As Integer, endrow As Integer, WB As Integer, RB As Integer, FI As Integer, CA As Integer, alexCounter As Integer, IMCounter As Integer
Dim alexDate As Date, deliveryDate As Date
Dim order As String

Application.ScreenUpdating = False

alexDate = courierDate("ALEX")
endrow = Workbooks("Workbook 1.xlsb").Worksheets("Masterlist").Cells(Rows.Count, 1).End(xlUp).Row
alexCounter = Workbooks("Workbook 2.xlsb").Worksheets("ALEX").Cells(Rows.Count, 2).End(xlUp).Row + 1
IMCounter = Workbooks("Workbook 2.xlsb").Worksheets("IMHD").Cells(Rows.Count, 2).End(xlUp).Row + 1

For i = endrow To 4 Step -1
 
 WB = Workbooks("Workbook 1.xlsb").Worksheets("Masterlist").Cells(i, 8)
 RB = Workbooks("Workbook 1.xlsb").Worksheets("Masterlist").Cells(i, 9)
 FI = Workbooks("Workbook 1.xlsb").Worksheets("Masterlist").Cells(i, 10)
 CA = Workbooks("Workbook 1.xlsb").Worksheets("Masterlist").Cells(i, 11)
 
 'Get delivery date
 deliveryDate = CDate(Workbooks("Workbook 1.xlsb").Worksheets("Masterlist").Cells(i, 6).Value)
 
 If (RB >= 1 Or WB >= 1 Or FI >= 1 Or CA >= 1) And deliveryDate = alexDate Then
 Call CopytoAlex(i, alexCounter, order)
 alexCounter = alexCounter + 1
 
 Next (RB >= 1 Or WB >= 1 Or FI >= 1 Or CA >= 1) And deliveryDate = alexDate Then
 Call CopytoIM(i, IMCounter, order)
 IMCounter = IMCounter + 1
 
 End If
 
Next i
End Function

标签： excelvba

解决方案

这段代码可以改进很多东西，但我只是要回答直接的问题，即如何交替输出工作表。我会尽量保留你在这里的大部分东西。

我希望你再声明一个整数变量，我们称之为 AlexOrIM。在开始循环之前将其设置为零，for i = endrow To 4 Step -1.

现在让我们重写那个循环：

For i = endrow To 4 Step -1

 WB = Workbooks("Workbook 1.xlsb").Worksheets("Masterlist").Cells(i, 8)
 RB = Workbooks("Workbook 1.xlsb").Worksheets("Masterlist").Cells(i, 9)
 FI = Workbooks("Workbook 1.xlsb").Worksheets("Masterlist").Cells(i, 10)
 CA = Workbooks("Workbook 1.xlsb").Worksheets("Masterlist").Cells(i, 11)

 'Get delivery date
 deliveryDate = CDate(Workbooks("Workbook 1.xlsb").Worksheets("Masterlist").Cells(i, 6).Value)

 If (RB >= 1 Or WB >= 1 Or FI >= 1 Or CA >= 1) And deliveryDate = alexDate Then
    If (AlexOrIM mod 2) = 0 Then
        Call CopytoAlex(i, alexCounter, order)
        alexCounter = alexCounter + 1
    Else
        Call CopytoIM(i, IMCounter, order)
        IMCounter = IMCounter + 1
    End If
    AlexOrIM=AlexOrIM + 1
 END IF 
Next i

测试 AlexOrIM 变量的偶数值（写入 alex）或奇数值（写入 IM）然后递增，以便下次通过它写入另一张表。

推荐阅读