作者热门文章
- html - 出于某种原因,IE8 对我的 Sass 文件中继承的 html5 CSS 不友好?
- JMeter 在响应断言中使用 span 标签的问题
- html - 在 :hover and :active? 上具有不同效果的 CSS 动画
- html - 相对于居中的 html 内容固定的 CSS 重复背景?
我在 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 子项中将列指定为字符串参数。
<小时/>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
之后:
关于vba - 如何对 A 列中具有相同值的一些数字求和?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/19490996/
我是一名优秀的程序员,十分优秀!