Question

我必须将列中的日期与当前日期进行比较，并将3个月添加到当前日期（表示当前日期和未来日期的两个日期），并将（<=180 days和<=90 days）文本替换为另一列如果未来日期大于列中的日期，如果未来日期小于列中的日期必须删除整行，并且宏还必须检查另一列中的文本（文本为{{1如果当前日期大于列中的日期。

让我解释整个代码的作用。

我已将基本数据的整个工作表（Expired）复制到主工作簿（应用程序）
从附图中的A列开始，我已经过滤了唯一值并放置在不同的列（AZ）。基于这些独特的价值，在执行宏期间，它将创建不同的工作簿。例如：APE.xlsx，SAD.xlsx，base.xlsx等等......
1. 我已将这些唯一值分配给数组
2. 我在同一个工作表（sheet1）中有另外两个过滤条件，但基于一个过滤条件，数据必须推送到另一个工作表（sheet1）并且必须使用其他过滤条件将数据填充到同一工作簿（APE.xlsx）的另一个工作表（Aging）
3. 与我对另一个工作表（Aging 3m）的处理方式相同。我比较了sheet2和sheet1中的数组，如果两者相等则创建一个带有数组名称的工作簿。

我想要的是：

我可以在sheet2使用两次相同的范围滤镜吗？
过滤条件不同，但必须使用相同的方法创建两个不同工作表（For ...loop）的日期同一工作簿的工作表（Aging, Aging 3mEx）。
对于工作表（sheet1），我必须将日期列（Aging 3m）与附加图片中的另一列（E）进行比较，将日期与当前日期和未来日期一个。如果未来日期大于日期在列G中，然后替换＆＃39;＆lt; = 90天＆＃39;到＆＃39;＆lt; = 180天＆＃39;
湾如果未来日期小于列E中的日期，然后删除整行。

注意：sArray具有唯一值（E，APE，APE_A，APE_D，APE_S，APE_U，{{1} }，APE_R，APE_O）和saArra有（APE_F，XXUMA，APE，APE_A，APE_D，{{ 1}}，APE_S，APE_U）

我的代码：

APE_R

继续

APE_O

Answer 1

查看此代码是否符合您的要求，如果您有更多问题，请与我们联系。

Sub VBA()
Dim TARGET_WB As Workbook
Dim ORIGINAL_WS, TARGET_WS As Worksheet

'将“ORIGINAL.xlsx”和“SHEET1”更改为您的实际原始数据工作簿和工作表名称

Set ORIGINAL_WS = Workbooks("ORIGINAL.xlsm").Sheets("SHEET1")

ROW_S = 2
DATA_C = 2

'将“C：\ Temp \”更改为您的实际原始数据路径

FILE_LOCATION = "C:\Temp\"

With ORIGINAL_WS
    While ROW_E < .Cells(Rows.Count, 1).End(xlUp).Row
        FILE_NAME = .Cells(ROW_S, 1) & ".xlsx"
        If Dir(FILE_LOCATION & FILE_NAME) = "" Then
            Set TARGET_WB = Workbooks.Add
            TARGET_WB.SaveAs FILE_LOCATIONI & FILE_NAME
            TARGET_WB.Sheets("SHEET1").Rows(1) = .Rows(1).Value
        Else
            WB_ALREADY_OPENED = False
            For Each WB In Application.Workbooks
                If WB.Name = FILE_NAME Then WB_ALREADY_OPENED = True
            Next WB
            If Not (WB_ALREADY_OPENED) Then Workbooks.Open (FILE_LOCATION & FILE_NAME)
            Set TARGET_WB = Workbooks(FILE_NAME)
        End If

        Set TARGET_WS = TARGET_WB.Sheets("SHEET1")

        ROW_E = ROW_S
        While .Cells(ROW_S, 1) = .Cells(ROW_E, 1)
            ROW_E = ROW_E + 1
        Wend
        DATA_LENTH = ROW_E - ROW_S
        TARGET_EOL = TARGET_WS.Cells(Rows.Count, 1).End(xlUp).Row + 1
        TARGET_WS.Cells(TARGET_EOL, 1).Resize(DATA_LENTH, 6) = .Cells(ROW_S, 1).Resize(DATA_LENTH, 6).Value


        For i = TARGET_EOL To TARGET_EOL + DATA_LENTH - 1
            With TARGET_WS.Range("G" & i)

'我使用了Select case功能让你更容易编辑

                If TARGET_WS.Range("E" & i) <> Empty Then
                    Select Case TARGET_WS.Range("E" & i) - DateAdd("M", 3, Date)
                        Case Is < 0: TARGET_WS.Rows(i).Delete: i = i - 1
                        Case 1 To 90: .Value = "<= 90"
                        Case 91 To 180: .Value = "<=180"
                        Case 181 To 270: .Value = "<=270"
                        Case 271 To 360: .Value = "<=360"
                        Case Is >= 361: .Value = ">=360"
                    End Select
                Else
                    If TARGET_WS.Cells(i, 1) <> Empty Then .Value = "SCI No Date"
                End If
            End With
        Next i

        ROW_S = ROW_E
    Wend
End With

For Each WB In Application.Workbooks
    If WB.Name <> ORIGINAL_WS.Parent.Name Then
        WB.Save
        WB.Close
    End If
Next WB


End Sub

这是做什么的

搜索列“A”并查找以“A”列命名的文件
如果没有文件存在，则创建工作簿。（例如APE.xlsx）
如果文件确实存在，请检查它们是否已打开，如果尚未打开则打开。
循环查找数据lenth
将数据复制到以“A”列命名的工作簿
循环复制数据以获取日期并计算差异
删除整行（如果列“E”日期） - （今天+ 3个月）小于0
在“G”栏（例如＆lt; = 90）
步骤1到8循环，直到它到达原始数据的结尾
保存并关闭除原始数据工作簿之外的所有工作簿

将日期与其他列进行比较，并用文本替换并删除vba中的行

1 个答案: