在Excel中使用VBA合并相同的数据 保留不同的数据(或替换不同的数据)

替换不同数据的宏代码:

Option Explicit
Sub hebing() '合并
Dim arr, h&, l%, i&, j&, n&
arr = Range("a1").CurrentRegion.Value
h = UBound(arr): l = UBound(arr, 2)
ReDim brr(1 To h, 1 To l)
For i = 1 To h - 1
    If arr(i, 1) <> ""Then
       n = n + 1
       For j = i + 1 To h
           If arr(i,1) = arr(j, 1) Then
              If arr(i, l) < arr(j, l)Then
                 arr(i, l) = arr(j, l)
                 arr(j, 1) = ""
              Else
                 arr(j, 1) = ""
              End If
           EndIf
       Next j
       For j = 1 To l
           brr(n, j)= arr(n, j)
       Next j
    End If
Next i
Range("h1").Resize(Rows.Count, l) = ""
Range("h1").Resize(h, l) = brr

End Sub


在Excel中使用VBA合并相同的数据 保留不同的数据(或替换不同的数据)_第1张图片

保留不同数据的宏代码:
Option Explicit
Sub hebing() '合并
Dim arr, h&, l%, i&, j&, n&
arr = Range("a1").CurrentRegion.Value
h = UBound(arr): l = UBound(arr, 2)
ReDim brr(1 To h, 1 To l)
For i = 1 To h - 1
    If arr(i, 1) <> ""Then
       n = n + 1
       For j = i + 1 To h
           If arr(i,1) = arr(j, 1) Then
                 arr(i, l) = arr(i, l) & arr(j,l)
                 arr(j, 1) = ""
           EndIf
       Next j
       For j = 1 To l
           brr(n, j)= arr(n, j)
       Next j
    End If
Next i
Range("h1").Resize(Rows.Count, l) = ""
Range("h1").Resize(h, l) = brr

End Sub

在Excel中使用VBA合并相同的数据 保留不同的数据(或替换不同的数据)_第2张图片

演示效果自行试验哦


你可能感兴趣的:(杂谈)