首页 > 解决方案 > 如果商品代码在excel中相同,如何将2个表合并为一个表并求和价格?

问题描述

在此处输入图像描述

大家好,

我想将表 1 和表 2 合并为一张表(表 3)。如果商品代码 1 和商品代码 2 相同,则将价格相加。最终输出应该类似于表 3。我不确定这是否可以在没有 VBA 的情况下完成,最好不要使用 VBA。但是,如果 excel 函数无法执行此分组任务,VBA 仍然可以。任何建议将不胜感激,谢谢!

标签: excelvbagroup-bysum

解决方案


请尝试下一个代码:

Sub JoinTables()
  Dim sh As Worksheet, T1 As ListObject, T2 As ListObject, T3 As ListObject
  Dim arr1, arr2, arr3, arrHead, dict As Object, i As Long, iRow As Long, iCol As Long
  
  Set sh = ActiveSheet 'use here the necessary sheet
  Set T1 = sh.ListObjects("Table1") 'use here your first table name
  Set T2 = sh.ListObjects(2)        'use here your second table name
  
  arr1 = T1.DataBodyRange.Value     'put the data body range in an array
  arr2 = T2.DataBodyRange.Value
  arrHead = T1.HeaderRowRange.Value 'put thea header in an array
  
  Set dict = CreateObject("Scripting.Dictionary") 'create a dictionary
  For i = 1 To UBound(arr1)
    dict(arr1(i, 1)) = arr1(i, 2) 'input all in the dictionary
  Next i
  
  For i = 1 To UBound(arr2)  'process the second table, too
    If Not dict.Exists(arr2(i, 1)) Then
        dict(arr2(i, 1)) = arr2(i, 2) 'create a new key
    Else
        dict(arr2(i, 1)) = dict(arr2(i, 1)) + arr2(i, 2) 'add to the existing key
    End If
  Next i

  'interesting way of obtaining an array by other (one column) arrays combination:
  arr3 = Application.Transpose(Array(dict.Keys, dict.Items)) 'combine the two array !!!

  iRow = T1.HeaderRowRange.row 'the row where the new Table will be created
  iCol = T2.HeaderRowRange.Column + T2.HeaderRowRange.Columns.count 'column of the new table

  sh.Range(sh.cells(iRow, iCol + 1), sh.cells(iRow, iCol + 2)).Value = arrHead 'put the header
  sh.cells(iRow, iCol + 1).Offset(1).Resize(UBound(arr3), UBound(arr3, 2)).Value = arr3 'put the content
  sh.cells(iRow, iCol + 1).CurrentRegion.Select 'select it to become a table in the next code line

  Set T3 = sh.ListObjects.Add  'create the new table
  'Copy the second column format in the new created table
  T3.DataBodyRange.Columns(2).NumberFormat = T1.DataBodyRange.Columns(2).NumberFormat
End Sub

编辑广告使用范围的版本:

Sub MergeRanges()
  Dim sh As Worksheet, lastR1 As Long, lastR2 As Long, firstCol1 As Long, firstCol2 As Long
  Dim arr1, arr2, arr3, arrHead, dict As Object, i As Long, iRow As Long, iCol As Long
  
  Set sh = ActiveSheet 'use here the necessary sheet
  firstCol1 = 7: firstCol2 = 10 'where are the first column of the two ranges
  iRow = 14                     ' the row where the header is
  
  lastR1 = sh.cells(rows.count, firstCol1).End(xlUp).row
  lastR2 = sh.cells(rows.count, firstCol2).End(xlUp).row
  
  arr1 = sh.Range(sh.cells(iRow + 1, firstCol1), sh.cells(lastR1, firstCol1 + 1)).Value 'put the range in an array
  arr2 = sh.Range(sh.cells(iRow + 1, firstCol2), sh.cells(lastR2, firstCol2 + 1)).Value
  arrHead = sh.Range(sh.cells(iRow, firstCol1), sh.cells(iRow, firstCol1 + 1)).Value  'put thea header in an array
  
  Set dict = CreateObject("Scripting.Dictionary") 'create a dictionary
  For i = 1 To UBound(arr1)
    dict(arr1(i, 1)) = arr1(i, 2) 'input all in the dictionary
  Next i
  
  For i = 1 To UBound(arr2)
    If Not dict.Exists(arr2(i, 1)) Then
        dict(arr2(i, 1)) = arr2(i, 2) 'create a new key
    Else
        dict(arr2(i, 1)) = dict(arr2(i, 1)) + arr2(i, 2) 'add to the existing key
    End If
  Next i
  
  arr3 = Application.Transpose(Array(dict.Keys, dict.Items)) 'combine the two array !!!

  iCol = firstCol2 + 3 'column of the new table
  
  sh.Range(sh.cells(iRow, iCol + 1), sh.cells(iRow, iCol + 2)).Value = arrHead 'put the header
  With sh.cells(iRow, iCol + 1).Offset(1).Resize(UBound(arr3), UBound(arr3, 2))
    .Value = arr3 'put the content
    .Columns(2).NumberFormat = sh.cells(iRow + 1, firstCol1 + 1).NumberFormat
  End With
End Sub

推荐阅读