VBA：通过macros将ColC中单元格的数量添加到另一行中的单元格

我想创build一个基于类似于下表的数据的macros。 如果名称是列A是“GA_RE_EM_DEL”，并在同一行B列中的date是> = 12/1/16，那么我想在该列C中的金额添加到列C中行A的列为“GA_RE_DA_DEL”，列B中的date与“GA_RE_EM_DEL”行中的date匹配。 无论在“GA_RE_EM_DEL”中的数量是多less，都应该改为0。

例如，根据下表，单元格A4包含“GA_RE_EM_DEL”，而B4中的date是> = 12/1/16。 既然这两个标准都满足了，我想findcol A包含“GA_RE_DA_DEL”的行，col B = B4（12/1/16）中的date。 符合这个标准的行是第5行。我想把C4中的数量加到C5中的数量（C5的最终结果将是30）。 然后C4中的数量应该改为0.我一直试图用一个循环来完成这个工作，但是迄今为止还没有能够创build任何值得发布的东西。 那是可以通过macros来完成的吗？

Answer 1

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

 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

我认为你已经很好地描述了这个问题。 尽pipe有很多硬编码的假设。 这段代码应该基于你所显示的确切值来工作 – 但是，列更改和比较值可能会改变代码将不得不进行调整。

希望这可以帮助你学习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