[英]Comparing multiple columns difficulty VBA Excel macro
我正在尝试检查A列第1行是否匹配B列第1行,如果匹配,则需要对E列第1行和E列第2行进行检查。 如果全部匹配,则需要显示C列第1行中的值。
如果A列第1行与B列第1行匹配,并且E列第1列与第2列第2行匹配,则移至第2列,并检查A列第2列是否与A列第2行匹配,如果匹配则检查E列第1列是否匹配E列2行。如果此匹配但行以下不匹配,则将C列中第1行和第2行的两个值相加。
我有这段代码:
Sub DemoNew()
Dim dict1 As Object
Dim c1 As Variant, k As Variant
Dim currWS As Worksheet
Dim i As Double, lastRow As Double, tot As Double
Dim number1 As Double, number2 As Double, firstRow As Double
Set dict1 = CreateObject("Scripting.Dictionary")
Set currWS = ThisWorkbook.Sheets("Sheet1")
'get last row withh data in Column A
lastRow = currWS.Cells(Rows.count, "A").End(xlUp).Row
'put unique numbers in Column A in dict1
c1 = Range("A2:B" & lastRow)
For i = 1 To UBound(c1, 1)
If c1(i, 1) <> "" Then
'make combination with first 4 characters
dict1(Left(c1(i, 1), 4) & "," & Left(c1(i, 2), 4)) = 1
End If
Next i
'loop through all the numbers in column A
For Each k In dict1.keys
number1 = Split(k, ",")(0)
number2 = Split(k, ",")(1)
tot = 0
firstRow = 0
For i = 2 To lastRow
If k = Left(currWS.Range("A" & i).Value, 4) & "," & Left(currWS.Range("B" & i).Value, 4) Then
If firstRow = 0 Then
firstRow = i
End If
tot = tot + currWS.Range("C" & i).Value
End If
Next i
currWS.Range("D" & firstRow) = tot
Next k
End Sub
我已经试过了:
If k = Left(currWS.Range("A" & i).Value, 4) & "," & Left(currWS.Range("B" & i).Value, 4) & (currWS.Range("E" & i).value) Then
但这并不能满足我的需求。
这是图形表示: 示例1
有什么建议么?
谢谢
这需要什么?
Sub DemoNew()
Dim dict1 As Object
Dim c1 As Variant, k As Variant
Dim currWS As Worksheet
Dim i As Double, lastRow As Double, tot As Double
Dim number1 As Double, number2 As Double, firstRow As Double
Dim DataArray
Set dict1 = CreateObject("Scripting.Dictionary")
Set currWS = ThisWorkbook.Sheets("Sheet1")
'get last row withh data in Column A
lastRow = currWS.Cells(Rows.Count, "A").End(xlUp).Row
'put your sheet into an array in memory so that it references faster
DataArray = Range("A2:E" & lastRow)
'loop through the array per your logic
For i = 1 To UBound(DataArray, 1) - 1
If DataArray(i, 1) <> "" And DataArray(i, 1) = DataArray(i, 2) And DataArray(i, 5) = DataArray(i + 1, 5) Then
tot = tot + DataArray(i, 3)
Else
DataArray(i, 4) = DataArray(i, 3)
End If
Next i
DataArray(UBound(DataArray, 1), 4) = DataArray(UBound(DataArray, 1), 3) ' last row will never match the next so set the value in D
'write modified data back into sheet
currWS.Range("A2:E" & lastRow) = DataArray
MsgBox ("Tot is: " & tot)
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.