集合中的“Object Required”错误

我有一个与我的VBA代码的问题，我试图消除列表中的重复偿还列表，同时积累列B和C的值，但这是有条件的，我的意思是消除重复是强制性的价值列A和H与重复行的值A和H相同，所以需要有两个条件来删除重复，谢谢你的帮助这是我以前build立的代码，但它给了我“需要的对象“错误

Excel表格的VBA代码

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 

Answer 1

您的问题可以通过更改行来解决

 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 ，或简单地dynamic标注的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 

注意：我不确定您的任何原始代码评论是否仍然有意义 – 我没有试图翻译他们，看看他们在说什么。

Answer 2

Col使用在概念上是错误的。

 Sub Bouton1_Cliquer() ' 28 Sep 2017 Dim Rng As Range Dim Rl As Long With Worksheets("Feuil1") Rl = .Cells(.Rows.Count, "A").End(xlUp).Row ' columns 1 = A, 8 = H .Range(.Cells(2, "A"), .Cells(Rl, .UsedRange.Columns.Count)) _ .RemoveDuplicates Columns:=Array(1, 8), Header:=xlNo Set Rng = .Range(.Cells(2, "B"), .Cells(Rl, "B")) Rl = .Cells(.Rows.Count, "B").End(xlUp).Row + 1 .Cells(Rl, "B").Value = Application.Sum(Rng) Rl = .Cells(.Rows.Count, "C").End(xlUp).Row + 1 .Cells(Rl, "C").Value = Application.Sum(Rng.Offset(0, 1)) End With End Sub 

正如你所看到的，用不同的概念你需要更less的代码。 或者，按照相反的顺序，使用“ Col的概念需要比原本需要更多的努力。