删除重复行并使用vba增加权重列

时间:2015-12-26 10:33:56

标签: excel vba duplicates

我正在尝试为源和目标单元格添加权重...所以我这样做:

  ' .Resize(, 4) = Array("Source", "Target", "Label", "Weight")
    .........

    Range(sStartingCellOutput).Offset(lRowOffset, lColOffset).Resize(1,4).Value = _
  Array(sq(lUser_1, 2), sqq(lUser_2), rTopic.Value,1)'

然后结果如下:

  'Source   Target  Label   Weight
    2955    7733    1       1
    7733    2955    1       1
    2961    6498    2       1
    6498    2961    2       1
    2961    2962    3       1
    2961    2962    3       1
    2962    2961    3       1
    2962    2961    3       1'

但我不想显示重复行(源和目标)我想删除副本并增加重量... 像这样:

    ' Source    Target  Label   Weight
      2955      7733        1       1
      7733      2955        1       1
      2961      6498        2       1
      6498      2961        2       1
      2961      2962        3       2
      2962      2961        3       2'

对此有何帮助?

谢谢

1 个答案:

答案 0 :(得分:0)

仅举例:(假设A1=Source / B1=Target / C1=Label / D1=Weight

Option Explicit

Dim i As Long, j As Long
i = 2
With ActiveSheet
  While Len(.Cells(i, 1).Value & .Cells(i, 2).Value & .Cells(i, 3).Value)
    j = i + 1
    While Len(.Cells(j, 1).Value & .Cells(j, 2).Value & .Cells(j, 3).Value)
      If .Cells(i, 1).Value = .Cells(j, 1).Value And .Cells(i, 2).Value = .Cells(j, 2).Value And .Cells(i, 3).Value = .Cells(j, 3).Value Then
        .Cells(i, 4).Value = .Cells(i, 4).Value + .Cells(j, 4).Value
        .Rows(j).Delete
      End If
      j = j + 1
    Wend
    i = i + 1
  Wend
End With

会做你想要的(以缓慢的方式)