intendo dire se ad esempio applico un filtro alla colonna G e vado ad analizzare un altra non mi deve andare ad azzerare il filtro G..quindi deve rimanere valorizzata..
Traduco: filtro manualmente una colonna, vorrei che la macro non mi eliminasse quel filtro.
Esecuzione: eliminiamo l'azzeramento dei filtri in avvio della macro e inseriamo l'azzeramento del solo filtro utilizzato dalla macro prima della conclusione della macro.
ho visto che durante l estrazione i valori vengono presi casualmente..sarebbe possibile averli ordinati in modo decrescente?è vero che lo posso fare manualmente ma quando faccio piu estrazioni diventa piu complicato e visivamente mi aiuta cercare cio che mi interessa
Non sono presi a caso, ma nell'ordine in cui compaiono nella colonna. Comunque si puo' fare.
Esecuzione: aggiunta della Function bbSort1d per ordinare la matrice dei valori
per quanto riguarda gli errori il div non da piu fastidio...
Bene bene
...ma per le colonne con i decimali funziona solo con 1 e vanno arrotondate..cmq non è un grosso problema anche se sarebbe curioso capire il perchè
Come detto mi aspetterei problemi con numeri irrazionali che per essere rappresentati usano tutte le cifre significative usate in Excel (15). Questo succede perche' la rappresentazione numerica del vba e' autonoma da quella fatta da excel, per cui il numero 0.123456789012345 in excel facilmente e' diverso dallo stesso numero memorizzato in vba.
Ma con pochi decimali non ho mai notato problemi. Tra l'altro il file che hai condiviso. contiene numerose colonne con 2 decimali, e su esse non ho problemi; se hai una colonna con valori che generano problemi allora condividi almeno quella colonna e vedremo di risolvere la cosa, o almeno di capirla
La penultima versione del codice quindi e':
- Codice: Seleziona tutto
Sub FiltraAndFiltra()
Dim AK As Worksheet, wCol As String, FilFiel As Long
Dim fArrZZZ(), vArr, FilRan As String, vInd As Long
Dim PronoVal As Range, I As Long, NextR As Long
Sheets("analisi").Select
wCol = Sheets("analisi").Range("A2")
FilFiel = Cells(1, wCol).Column
Set AK = Sheets("ARCHIVIO")
Set PronoVal = Sheets("PRONO%").Range("A8:Q8")
'
FilRan = AK.AutoFilter.Range.Address
''On Error Resume Next
'' AK.Range(FilRan).AutoFilter field:=FilFiel
'' If AK.AutoFilterMode Then AK.ShowAllData
''On Error GoTo 0
'
'Per ricerche ripetute:
Dim StaR As Long
StaR = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Debug.Print "INIZIO per " & wCol & " / " & StaR
Cells(StaR, 1) = wCol
Cells(StaR, 1).HorizontalAlignment = xlLeft
'<<< End
If Application.WorksheetFunction.CountA(AK.Cells(7, wCol).Resize(2)) > 0 Then
vArr = AK.Range(AK.Cells(7, wCol), AK.Cells(10000, wCol).End(xlUp)).Value
vArr = bbSort1d(vArr)
Debug.Print "Ubound vARR: " & UBound(vArr)
vInd = 0
For I = 6 To 6 + UBound(vArr) - 1
vInd = vInd + 1
'If /End if aggiuntivo per evitare di usare valori in errore
If Not IsError(vArr(vInd, 1)) Then
If IsError(Application.Match(" " & vArr(vInd, 1), Range("A" & StaR).Resize(UBound(vArr), 1), False)) Then
AK.Range(FilRan).AutoFilter field:=FilFiel, Criteria1:=CStr(vArr(vInd, 1))
If Sheets("Archivio").Range("C2") = 0 Then
Debug.Print "Trovato 0: (wCol / filtro) " & wCol & " --/-- " & vArr(vInd, 1)
End If
NextR = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextR, 1).Value = "' " & vArr(vInd, 1)
Cells(NextR, 2).Resize(1, PronoVal.Columns.Count).Value = PronoVal.Value
End If
End If
DoEvents
Next I
PronoVal.Copy
If NextR > 0 Then
Range("B3:R" & NextR).PasteSpecial xlPasteFormats
Cells(StaR + 1, 1).Resize(NextR - StaR, 1).HorizontalAlignment = xlCenter
End If
Application.CutCopyMode = False
Range("A2").Select
End If
AK.Range(FilRan).AutoFilter field:=FilFiel
Debug.Print "End per " & wCol, "Area: " & StaR & ":" & NextR
Beep
End Sub
Function bbSort1d(ByRef oArr) As Variant
Dim tArr, I As Long, J As Long
'
'ordinamento in Bubble Sort:
For I = 1 To UBound(oArr) - 2
If Not IsError(oArr(I, 1)) Then
For J = I + 1 To UBound(oArr) - 1
If oArr(I, 1) > oArr(J, 1) Then
tArr = oArr(I, 1)
oArr(I, 1) = oArr(J, 1)
oArr(J, 1) = tArr
End If
Next J
End If
Next I
bbSort1d = oArr
End Function
Registrazione
solo se puoi..sempre grazie infinite
cosa vorresti...