Question

我有以下工作表

XXX的用户

Users    Access
Foo      30
Bar      45

来自YYY的用户

Users    Access
Beef     90
Foo      85

访问总数

Users    Access

如果 XXX 表中的用户与 YYY 表中的用户匹配，那么我要附加用户和以下项的 sum 将两个工作表的访问都合并为访问总数一个

到目前为止，我已经提出了

Sub CalcularSoma()
  Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, r_users_a As Range, r_acessos_a As Range, r_users_b As Range, r_acessos_b As Range
  Set sh1 = Worksheets("Users XXX")
  Set sh2 = Worksheets("Users YYY")
  Set sh3 = Worksheets("Sum of all")

  Set r_users_a = sh1.Range("A2")
  Set r_acess_a = sh1.Range("B2")

  Set r_users_b = sh2.Range("A2")
  Set r_acess_b = sh2.Range("B2")

End Sub

但是我无法理解如何遍历每一个然后追加

Answer 1

您可以使用ShellExecute循环转到For each的每个单元格，然后使用USER XXX的另一个单元格在另一个表中存在匹配项时最终粘贴。

USER YYY

Answer 2

您可以使用Dictionary Object保存每个唯一项，并更新值。

Sub CalcularSoma()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, r_users_a As Range, r_acessos_a As Range, r_users_b As Range, r_acessos_b As Range
Set sh1 = Worksheets("Users XXX")
Set sh2 = Worksheets("Users YYY")
Set sh3 = Worksheets("Sum of all")


Set r_users_a = sh1.Range("A2:A" & sh1.Range("A" & sh1.Range("A:A").Rows(sh1.Range("A:A").Rows.Count).Row).End(xlUp).Row)
Set r_acess_a = sh1.Range("B2")


Set r_users_b = sh2.Range("A2:A" & sh2.Range("A" & sh2.Range("A:A").Rows(sh2.Range("A:A").Rows.Count).Row).End(xlUp).Row)
Set r_acess_b = sh2.Range("B2")

'We use the Dictionary
Dim Dict As Scripting.Dictionary
Set Dict = New Scripting.Dictionary
Dict.CompareMode = vbTextCompare 'Make key non case sensitive (the dictionary must be empty).


Dim Rng As Range

For Each Rng In r_users_a
    If Dict.Exists(Rng.Value) Then
        'we update value
        Dict(Rng.Value) = Dict(Rng.Value) + Rng.Offset(0, 1).Value
    Else
        'we add it
        Dict.Add (Rng.Value), Rng.Offset(0, 1).Value
    End If
Next Rng

For Each Rng In r_users_b
    If Dict.Exists(Rng.Value) Then
        'we update value
        Dict(Rng.Value) = Dict(Rng.Value) + Rng.Offset(0, 1).Value
    Else
        'we add it
        Dict.Add (Rng.Value), Rng.Offset(0, 1).Value
    End If
Next Rng

Dim i As Long
For i = 0 To Dict.Count - 1 Step 1
   Debug.Print Dict.Keys(i), Dict.Items(i)
Next i

Dict.RemoveAll

Set Dict = Nothing

End Sub

执行此操作后，我得到：

Foo            115 
Bar            45 
Beef           90

Excel VBA-将来自不同工作表的所有访问和用户汇总到新工作表中

2 个答案: