VBA：通过宏

Question

我想根据类似下表的数据创建一个宏。如果名称为A列，则为＆＃34; GA_RE_EM_DEL＆＃34;并且在同一行中，col B中的日期是> = 12/1/16，那么我希望将该行中的数量添加到col中的col C中，其中col A是＆＃34; GA_RE_DA_DEL＆＃34;，col B中的日期与行中的日期匹配＆＃34; GA_RE_EM_DEL＆＃34;。无论金额是多少？＃34; GA_RE_EM_DEL＆＃34;然后应该改为0。

例如，根据下表，单元格A4包含＆＃34; GA_RE_EM_DEL＆＃34;，B4中的日期> = 12/1/16。既然满足了这两个标准，我想找到col A包含＆＃34; GA_RE_DA_DEL＆＃34;的行，以及col B = B4（12/1/16）中的日期。符合此条件的行是第5行。我想取C4中的金额并将其添加到C5中的金额（C5中的最终结果将为30）。然后C4中的数量应该更改为0.我一直试图用循环完成这个，但是到目前为止还没有能够创建任何值得发布的东西。这是可以通过宏完成的吗？

Answer 1

我想你已经很好地描述了这个问题。虽然有很多硬编码的假设。此代码应根据您显示的确切值运行 - 但是如果列更改和比较值可能会更改代码，则必须进行调整。

希望这会让你在学习VBA的过程中开始运作

Option Explicit

Public Sub RedoCells()

    Const LOOKUP_START  As String = "GA_RE_EM_DEL"
    Const LOOKUP_MATCH  As String = "GA_RE_DA_DEL"

    Const MIN_DATE      As Date = #12/1/2016#

    Const LOOKUP_COL    As Integer = 1
    Const DATE_COL      As Integer = 2
    Const VALUE_COL     As Integer = 3

    Dim rge         As Range

    Dim intRow      As Integer
    Dim intCol      As Integer
    Dim intRows     As Integer
    Dim intColumns  As Integer

    Dim intLastRow  As Integer

    Dim strLookup   As String
    Dim datLookup   As Date

    Dim varData As Variant

    ' Select all data
    Range("A1").CurrentRegion.Select
    Set rge = Range("A1").CurrentRegion

    varData = Selection

    intRows = Selection.Rows.Count
    For intRow = 2 To intRows
        strLookup = varData(intRow, LOOKUP_COL)

        ' Check for Row Match
        If (strLookup = LOOKUP_START) And (varData(intRow, DATE_COL) >= MIN_DATE) Then

            ' Start Looking for match at next row
            intNextRow = intRow

            Do Until (varData(intNextRow, LOOKUP_COL) = LOOKUP_MATCH) Or varData(intNextRow, LOOKUP_COL) = ""
                intNextRow = intNextRow + 1

                ' Check for matching date for row value
                If varData(intNextRow, DATE_COL) = varData(intRow, DATE_COL) Then

                    ' Add previous value to current value
                    varData(intNextRow, VALUE_COL) = varData(intNextRow, VALUE_COL) + varData(intRow, VALUE_COL)

                    ' Zero out previous value
                    varData(intRow, VALUE_COL) = 0
                    Exit Do
                End If
            Loop

        End If

    Next intRow

    ' Save all data back to previous range
    Range("A1").CurrentRegion = varData
End Sub    

Answer 2

假设您在Cell E2中提供日期，请尝试以下操作：

Sub Demo()
    Dim rFound As Range, rng As Range, foundRng As Range
    Dim strName1 As String, strName2 As String
    Dim count As Long, LastRow As Long

    Set rng = Range("A:A")

    On Error Resume Next
    'assign strings to be searched
    strName1 = "GA_RE_EM_DEL"
    strName2 = "GA_RE_DA_DEL"

    'loop two times to find two strings "GA_RE_EM_DEL" and "GA_RE_DA_DEL"
    For i = 1 To 2
        If i = 1 Then
            strName = strName1
        Else
            strName = strName2
        End If

        'find the string in Column A
        With rng
            Set rFound = .Find(What:=strName, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
            If Not rFound Is Nothing Then
                FirstAddress = rFound.Address
                Do
                    'if string found compare the date
                    If rFound.Offset(0, 1) >= DateValue(Range("E2").Value) Then
                        If i = 1 Then
                            Set foundRng = rFound
                        End If
                        Exit Do
                    Else
                        Set rFound = .FindNext(rFound)
                    End If
                Loop While Not rFound Is Nothing And rFound.Address <> FirstAddress
            End If
        End With
    Next i
    On Error GoTo 0

    'adding values
    If Not foundRng Is Nothing And Not rFound Is Nothing Then
        rFound.Offset(0, 2).Value = rFound.Offset(0, 2).Value + foundRng.Offset(0, 2).Value
        foundRng.Offset(0, 2).Value = 0
    Else
        MsgBox "No Data Found"
    End If
End Sub