我的 VBA 代码有问题,我尝试在累积 B 和 C 列的值的同时消除报销列表的重复项,但这是有条件的,我的意思是消除重复项是强制性的A列和H列与重复行的值A和H相同,因此需要有两个条件才能删除重复项,谢谢您的帮助
这是我之前构建的代码,但它给了我“需要对象”错误
excel table of the vba code
Sub Bouton1_Cliquer()
Dim Cel As Range
Dim Cel1 As Range
Dim Plage As Range
Dim Plage1 As Range
Dim Col As New Collection
Dim col1 As New Collection
Dim Cumul As Double
Dim Cumul1 As Double
Dim DerLig As Long, i As Long, j As Long, MémoL As Long, p As Long
Dim PremL As Boolean
Dim CodeADELI As String
Application.ScreenUpdating = False
Set Col = New Collection
Set col1 = New Collection
On Error Resume Next
With Worksheets("Feuil1") 'Nom de feuille à adapter
DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
DerLig1 = .Range("H" & .Rows.Count).End(xlUp).Row
'Les Codes ADELI sont placés dans une collection afin d'obtenir une liste sans doublon
Set Plage = .Range("A2:A" & DerLig)
Set Plage1 = .Range("H2:H" & DerLig1)
For Each Cel In Plage
If Cel <> "" Then Col.Add Cel, CStr(Cel)
Next Cel
For Each Cel1 In Plage1
If Cel1 <> "" Then col1.Add Cel1, CStr(Cel1)
Next Cel1
On Error GoTo 0
'On boucle sur chaque élément de la collection que l'on compare aux codes de la liste.
For i = 1 To Col.Count
For p = 1 To col1.Count
Cumul1 = 0
Cumul = 0 'Initialisation du total
MémoL = 0
PremL = True
CodeADELI = Col(i)
INSEE = col1(p)
'chaque élément de la collection est comparé aux codes de la liste.
For j = DerLig To 2 Step -1
If .Range("A" & j).Value = CodeADELI And .Range("H" & j).Value = INSEE Then
'On ajoute le montant au cumul
Cumul = Cumul + .Range("B" & j).Value
Cumul1 = Cumul1 + .Range("C" & j).Value
'S'il s'agit de la première ligne , on mémorise le numéro de ligne
If PremL Then
MémoL = j
PremL = False
'Sinon, on supprime la ligne (doublon)
Else
.Rows(j).Delete
MémoL = MémoL - 1
DerLig = DerLig - 1
DerLig1 = DerLig
End If
End If
Next j
'Le cumul est affecté au montant de la ligne qui reste
If MémoL > 0 Then .Range("C" & MémoL) = Cumul1
If MémoL > 0 Then .Range("B" & MémoL) = Cumul
Next p
Next i
End With
End Sub
最佳答案
您的问题可以通过更改线路来解决
If Cel <> "" Then Col.Add Cel, CStr(Cel)
和
If Cel1 <> "" Then col1.Add Cel1, CStr(Cel1)
至
If Cel <> "" Then Col.Add CStr(Cel), CStr(Cel)
和
If Cel1 <> "" Then col1.Add Cstr(Cel1), CStr(Cel1)
该错误是由于稍后在您的代码中使用
col(i)
引起的。和 col1(p)
,该集合引用了一个范围对象,该对象已被 .Rows(j).Delete
的代码行删除。 .通过将集合更改为单元格的值,而不是单元格本身,它不会因删除行而被破坏。
一个
Dictionary
, 或者只是一个动态尺寸的String
数组,可能是跟踪您希望匹配哪些“键”的更好方法。Sub Bouton1_Cliquer()
Dim dict As Dictionary
Dim key As Variant
Dim Cumul As Double
Dim Cumul1 As Double
Dim DerLig As Long, i As Long, j As Long, MémoL As Long
Dim PremL As Boolean
Application.ScreenUpdating = False
Set dict = New Dictionary
With Worksheets("Feuil1") 'Nom de feuille à adapter
DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To DerLig
If Not dict.Exists(.Cells(i, "A") & "|" & .Cells(i, "H")) Then
dict.Add .Cells(i, "A") & "|" & .Cells(i, "H"), .Cells(i, "A") & "|" & .Cells(i, "H")
End If
Next
For Each key In dict.Keys
Cumul1 = 0
Cumul = 0 'Initialisation du total
MémoL = 0
PremL = True
'chaque élément de la collection est comparé aux codes de la liste.
For j = DerLig To 2 Step -1
If key = .Cells(j, "A").Value & "|" & .Cells(j, "H").Value Then
'On ajoute le montant au cumul
Cumul = Cumul + .Range("B" & j).Value
Cumul1 = Cumul1 + .Range("C" & j).Value
'S'il s'agit de la première ligne , on mémorise le numéro de ligne
If PremL Then
MémoL = j
PremL = False
'Sinon, on supprime la ligne (doublon)
Else
.Rows(j).Delete
MémoL = MémoL - 1
DerLig = DerLig - 1
End If
End If
Next j
'Le cumul est affecté au montant de la ligne qui reste
If MémoL > 0 Then .Range("C" & MémoL) = Cumul1
If MémoL > 0 Then .Range("B" & MémoL) = Cumul
Next
End With
End Sub
注意:我不确定您的任何原始代码注释是否仍然有意义 - 我没有尝试翻译它们以查看它们在说什么。
关于vba - "Object Required"集合错误,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/46466342/