VBA：通過宏將ColC中單元格的單元格添加到另一個單元格中的單元格

Question

我想基於類似於下表的數據創建一個宏。如果名稱是A列是「GA_RE_EM_DEL」，並且在同一行中B列中的日期是> = 12/1/16，那麼我希望該列中的列C的數量增加到列C中的列C中其中col A爲「GA_RE_DA_DEL」的行中，col B中的日期與具有「GA_RE_EM_DEL」的行中的日期相匹配。然後應將「GA_RE_EM_DEL」中的數量改爲0.

例如，根據下表，單元格A4包含「GA_RE_EM_DEL」，並且B4中的日期爲> = 12/1/16。既然這兩個標準都滿足了，我想找到col A包含「GA_RE_DA_DEL」的行，col B = B4（12/1/16）中的日期。符合這個標準的行是第5行。我想把C4中的數量加到C5中的數量上（C5的最終結果就是30）。然後C4中的數量應該改爲0.我一直試圖用一個循環來完成這件事，但迄今爲止還沒有能夠創建任何值得發佈的東西。那是可以通過宏來完成的嗎？

Answer 1

假設你在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 

Answer 2

我想你，已經說明這個問題很好。儘管有很多硬編碼的假設。這段代碼應該基於你所顯示的確切值進行工作 - 但是，列更改和比較值可能會改變代碼，必須進行調整。

希望這將讓你和你的追求上運行一個學習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