如何用vba设置行自动成对

yiwancn

见附件，要求源表变成目标表的样子，即物料行的如果是单行的，插入物料行补充成对，已经成对的不用动，并且不改变表格原次序。

syj2004hg

1. Sub New11()
   
2.     Dim i As Long, str As String, LstRow As Long
   
3.     LstRow = Range("C10000").End(xlUp).Row
   
4.     For i = LstRow To 2 Step -1
   
5.         str = Cells(i, 3)
   
6.         If WorksheetFunction.CountIf(Range("C:C"), str) < 2 Then
   
7.             Cells(i + 1, 1).EntireRow.Insert
   
8.             Cells(i + 1, 3) = Cells(i, 3)
   
9.         End If
   
10.     Next i
    
11. End Sub

复制代码

yiwancn

syj2004hg 发表于 2020-3-6 22:54

感谢，很好用还有个问题，如果相同的物料出现次数超过2次，比如3次，5次，这个怎么处理？

yiwancn

yiwancn 发表于 2020-3-7 12:39
感谢，很好用

还有个问题，如果相同的物料出现次数超过2次，比如3次，5次，这个怎么处理？

yiwancn

yiwancn 发表于 2020-3-7 13:01
还有个问题，如果相同的物料出现次数超过2次，比如3次，5次，这个怎么处理？

这个问题解决了，稍微修改了一下代码，这里表示再次感谢，解决大于2次，奇数不成对问题，代码如下：
Sub New11()
    Dim i As Long, str As String, LstRow As Long
    LstRow = Range("C10000").End(xlUp).Row
    For i = LstRow To 2 Step -1
        str = Cells(i, 3)
        If WorksheetFunction.CountIf(Range("C:C"), str) Mod 2 <> 0 Then
           '要成对出现，必须是偶数，如2、4、6等，用mod判断即可，<>0表示出现3、5、7等次数。
            Cells(i + 1, 1).EntireRow.Insert
            Cells(i + 1, 3) = Cells(i, 3)
        End If
    Next i
End Sub