Moderatori: Anthony47, Flash30005
Sub CancellaVal()
Application.ScreenUpdating = False
Application.Calculation = xlManual
UR = Range("A" & Rows.Count).End(xlUp).Row
For RR = 1 To UR - 1
For RR2 = RR + 1 To UR
If Evaluate("=SUM(COUNTIF(Foglio1!A" & RR & ":E" & RR & ",Foglio1!A" & RR2 & ":E" & RR2 & "))") = 5 Then Range("A" & RR2 & ":E" & RR2).ClearContents
If Evaluate("=SUM(COUNTIF(Foglio1!A" & RR & ":E" & RR & ",Foglio1!L" & RR2 & ":P" & RR2 & "))") = 5 Then Range("L" & RR2 & ":P" & RR2).ClearContents
If Evaluate("=SUM(COUNTIF(Foglio1!L" & RR & ":P" & RR & ",Foglio1!A" & RR2 & ":E" & RR2 & "))") = 5 Then Range("A" & RR2 & ":E" & RR2).ClearContents
If Evaluate("=SUM(COUNTIF(Foglio1!L" & RR & ":P" & RR & ",Foglio1!L" & RR2 & ":P" & RR2 & "))") = 5 Then Range("L" & RR2 & ":P" & RR2).ClearContents
Next RR2
Next RR
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub CancellaVal()
[R1] = Int(Timer)
Application.ScreenUpdating = False
Application.Calculation = xlManual
UR = Range("A" & Rows.Count).End(xlUp).Row
For RR = 1 To UR - 1
If Range("A" & RR).Value = "" And Range("L" & RR).Value = "" Then GoTo SaltaRR
For RR2 = RR + 1 To UR
If Range("A" & RR2).Value = "" And Range("L" & RR2).Value = "" Then GoTo SaltaRR2
If Evaluate("=SUM(COUNTIF(Foglio1!A" & RR & ":E" & RR & ",Foglio1!A" & RR2 & ":E" & RR2 & "))") = 5 Then Range("A" & RR2 & ":E" & RR2).ClearContents
If Evaluate("=SUM(COUNTIF(Foglio1!A" & RR & ":E" & RR & ",Foglio1!L" & RR2 & ":P" & RR2 & "))") = 5 Then Range("L" & RR2 & ":P" & RR2).ClearContents
If Evaluate("=SUM(COUNTIF(Foglio1!L" & RR & ":P" & RR & ",Foglio1!A" & RR2 & ":E" & RR2 & "))") = 5 Then Range("A" & RR2 & ":E" & RR2).ClearContents
If Evaluate("=SUM(COUNTIF(Foglio1!L" & RR & ":P" & RR & ",Foglio1!L" & RR2 & ":P" & RR2 & "))") = 5 Then Range("L" & RR2 & ":P" & RR2).ClearContents
SaltaRR2:
Next RR2
SaltaRR:
Next RR
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
[S1] = Int(Timer)
[T1] = [S1] - [R1]
End Sub
Sub BxorAColl()
'wip con uso di Collection
'
Dim AColl As New Collection
'
Dim myArrC(), myVArrA, myVArrB, LastA As Long, LastB As Long
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Range("R:V").Clear
'
LastA = Cells(Rows.Count, 12).End(xlUp).Row
LastB = Cells(Rows.Count, 1).End(xlUp).Row
ReDim myArrC(1 To LastB)
[G1] = Timer
myVArrA = Range("L1:P" & LastA).Value
myVArrB = Range("A1:E" & LastB).Value
'Col A -> Collection:
For I = LBound(myVArrA, 1) To LastA
On Error Resume Next
myItem = myVArrA(I, 1) & "-" & myVArrA(I, 2) & "-" & myVArrA(I, 3) & "-" & _
myVArrA(I, 4) & "-" & myVArrA(I, 5)
'If Application.WorksheetFunction.IsText(myVArrA(I, 1)) Then
AColl.Add myItem, myItem
'End If
Next I
On Error GoTo 0
[G2] = Timer
'Confronta col B con la Collection:
For I = 1 To LastB
'If Application.WorksheetFunction.IsText(myVArrB(I, 1)) Then
Err.Clear
On Error Resume Next
yrItem = myVArrB(I, 1) & "-" & myVArrB(I, 2) & "-" & myVArrB(I, 3) & _
"-" & myVArrB(I, 4) & "-" & myVArrB(I, 5)
scrvar = AColl.Item(yrItem)
errNum = CLng(Err.Number)
On Error GoTo 0
If errNum = 5 Then 'missing...
J = J + 1
myArrC(J) = yrItem
Else
cvcv = 1 'solo per debug
End If
'End If
Next I
'
'Carica risultato in col C
ReDim Preserve myArrC(1 To J)
If J < 65536 Then
Range("R1:R" & UBound(myArrC, 1)) = Application.WorksheetFunction.Transpose(myArrC())
Else
For I = 1 To J
Cells(I, "R") = myArrC(I)
Next I
End If
'Testo in colonna
Columns("R:R").Select
Selection.TextToColumns Destination:=Range("R1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
1)), TrailingMinusNumbers:=True
Range("L1").Select
[G3] = Timer
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Io mi ero attenuto a questo.è possibile con una macro confrontare velocemente circa 500.000 combinazioni A:E (prima serie Base) con altrentante combinazioni, o meno o più, scritte sullo stesso foglio L:P (o altro foglio) cancellando sulla Base A:E le combinazioni in comune?
Torna a Applicazioni Office Windows
Macro modifica date scelta periodo Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 11 |
Supporto per sviluppo macro VBA Ordinare per data Autore: Carletto Ribolla |
Forum: Applicazioni Office Windows Risposte: 3 |
Inserire add.in nella barra di avvio veloce in excel 2003 Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 4 |
Excel: problema con date se devo unirle a testi Autore: valle1975 |
Forum: Applicazioni Office Windows Risposte: 5 |
Visitano il forum: Nessuno e 17 ospiti