[英]How can i sum some numbers with same value in A column?
我在A欄中有一些名稱,在B欄中有一些數字,例如:
jimmy 4
jimmy 4
carl 8
john 8
我需要對吉米的數字求和。 我的意思是,如果A列中有一些相同的值,則該名稱的B個數字之和。 吉米=8。我該怎么做? 我在vba中是新手,所以對我來說不容易的事情就不那么容易了:)
編輯,宏:
Sub Sample()
Dim path As String
Dim openWb As Workbook
Dim openWs As Worksheet
Dim DataInizio As String
Dim DataFine As String
path = "C:\Me\Desktop\example.xls"
Set thiswb = ThisWorkbook
Set openWb = Workbooks.Open(path)
Set openWs = openWb.Sheets("details")
Set Logore = thiswb.Sheets("Log")
With openWs
start = CDate(InputBox("start (gg/mm/aaaa)"))
end = CDate(InputBox("end (gg/mm/aaaa)"))
Sheets("details").Select
LR = Cells(Rows.Count, "A").End(xlUp).Row
dRow = 2
For r = 2 To LR
If Cells(r, 1) >= start And Cells(r, 1) <= end Then
' Do un nome alle colonne nel file di log indicandone la posizione
ore = Range("K" & r)
nome = Range("J" & r)
totore = totore + ore
If ore <> 8 Then
Range("A" & r & ",J" & r & ",D" & r & ",K" & r).Copy Logore.Cells(dRow, 1)
rigatot = dRow
dRow = dRow + 1
End If
If nome <> Range("J" & r + 1) Then
If totore <> 40 Then
Logore.Cells(dRow, 5) = totore
End If
totore = 0
End If
End If
Next
thiswb.Sheets("Log").Activate
End With
openWb.Close (False)
End Sub
好了,此宏將匯總這些值並將其重新打印為新列表。 您可以在Main子目錄中將列指定為String參數。
CollectArray "A", "D"
-從A
列收集數組,並從中刪除重復項,然后將其打印到D
列
DoSum "D", "E", "A", "B"
-匯總D
列的所有值並將它們寫入E
列-從A
列獲取匹配項,從B
列獲取值
Option Explicit Sub Main() CollectArray "A", "D" DoSum "D", "E", "A", "B" End Sub ' collect array from a specific column and print it to a new one without duplicates ' params: ' fromColumn - this is the column you need to remove duplicates from ' toColumn - this will reprint the array without the duplicates Sub CollectArray(fromColumn As String, toColumn As String) ReDim arr(0) As String Dim i As Long For i = 1 To Range(fromColumn & Rows.Count).End(xlUp).Row arr(UBound(arr)) = Range(fromColumn & i) ReDim Preserve arr(UBound(arr) + 1) Next i ReDim Preserve arr(UBound(arr) - 1) RemoveDuplicate arr Range(toColumn & "1:" & toColumn & Range(toColumn & Rows.Count).End(xlUp).Row).ClearContents For i = LBound(arr) To UBound(arr) Range(toColumn & i + 1) = arr(i) Next i End Sub ' sums up values from one column against the other column ' params: ' fromColumn - this is the column with string to match against ' toColumn - this is where the SUM will be printed to ' originalColumn - this is the original column including duplicate ' valueColumn - this is the column with the values to sum Private Sub DoSum(fromColumn As String, toColumn As String, originalColumn As String, valueColumn As String) Range(toColumn & "1:" & toColumn & Range(toColumn & Rows.Count).End(xlUp).Row).ClearContents Dim i As Long For i = 1 To Range(fromColumn & Rows.Count).End(xlUp).Row Range(toColumn & i) = WorksheetFunction.SumIf(Range(originalColumn & ":" & originalColumn), Range(fromColumn & i), Range(valueColumn & ":" & valueColumn)) Next i End Sub Private Sub RemoveDuplicate(ByRef StringArray() As String) Dim lowBound$, UpBound&, A&, B&, cur&, tempArray() As String If (Not StringArray) = True Then Exit Sub lowBound = LBound(StringArray): UpBound = UBound(StringArray) ReDim tempArray(lowBound To UpBound) cur = lowBound: tempArray(cur) = StringArray(lowBound) For A = lowBound + 1 To UpBound For B = lowBound To cur If LenB(tempArray(B)) = LenB(StringArray(A)) Then If InStrB(1, StringArray(A), tempArray(B), vbBinaryCompare) = 1 Then Exit For End If Next B If B > cur Then cur = B tempArray(cur) = StringArray(A) Next A ReDim Preserve tempArray(lowBound To cur): StringArray = tempArray End Sub
后:
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.