Quindi mi pare che il problema principale sta nel fatto che l'area di origine della Pivot cambia in modo apparentemente arbitrario durante la manipolazione di Foglio14 (l'origine dei dati).
Non so quale e' la "prestazione" che porta a questo comportamento, quindi la aggiro con la compilazione esplicita (in coda alla macro) dell'origine dati che la pivot deve prendere in cosiderazione. Il codice specifico, inserito subito prima di End Sub:
- Codice: Seleziona tutto
'AGGIORNA Origine Dati per TabellaPivot:
pvtsh = "Foglio16"
datash = "Foglio14"
nwrange = datash & "!" & Sheets(datash).Range("A1:M1").Resize(ultima_riga_casa).Address(ReferenceStyle:=xlR1C1)
Sheets(pvtsh).PivotTables(1).ChangePivotCache _
ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=nwrange)
'Aggiorna Pivot
Sheets(pvtsh).PivotTables(1).PivotCache.Refresh
Ci sono pero' alcune piccole discrepanze qua e là, che mi hanno portato a editare complessivamente la macro come segue:
- Codice: Seleziona tutto
Sub solocellevisibilifiltrateDUE()
Application.ScreenUpdating = False
''INUTILI:
'' Sheets("Foglio14").Select
'' Range("a1:k2000").Select
'' Selection.ClearContents
Sheets("OrdiniVendita").Select
Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$K$2000").AutoFilter Field:=5, Criteria1:="<>*fr*"
''Approccio diverso:
'' Range("A1").Select
'' Range(Selection, Selection.End(xlDown)).Select
'' Range(Selection, Selection.End(xlToRight)).Select
'' Selection.SpecialCells(xlCellTypeVisible).Select
Range("A:K").Select
Selection.Copy
Sheets("Foglio14").Select
''Per impostare l'origine dell'Incolla:
Range("A1").Select
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
Rows("1:1").Select
Selection.AutoFilter
Range("F11").Select
'' AREE PROBABILMENTE PARZIALI:
'' ActiveSheet.Range("$A$1:$M$381").AutoFilter Field:=6
'' ActiveSheet.Range("$A$1:$M$381").AutoFilter Field:=6, Criteria1:="*can*"
'' ActiveSheet.Range("$A$1:$M$381").AutoFilter Field:=6, Criteria1:="*cav*"
ActiveSheet.Range("$A$1:$M$2000").AutoFilter Field:=6
ActiveSheet.Range("$A$1:$M$2000").AutoFilter Field:=6, Criteria1:="*can*"
ActiveSheet.Range("$A$1:$M$2000").AutoFilter Field:=6, Criteria1:="*cav*"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.EntireRow.Delete
''idem:
'' ActiveSheet.Range("$A$1:$M$259").AutoFilter Field:=6, Criteria1:="*che*"
ActiveSheet.Range("$A$1:$M$2000").AutoFilter Field:=6, Criteria1:="*che*"
''PERCHE' DA a6??
'' Range("A6").Select
'' Range(Selection, Selection.End(xlToRight)).Select
Range(Range("A2"), Range("A2").End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.EntireRow.Delete
Rows("1:1").Select
Selection.AutoFilter
Dim I As Long, J As Long, mySplit, xPos
Range("j:k").Clear
For I = 2 To Cells(Rows.Count, 1).End(xlUp).Row
mySplit = Split(Replace(Cells(I, "F").Value & " A E", ".", ",", , , vbTextCompare), " ", , vbTextCompare)
For J = 0 To UBound(mySplit)
xPos = InStr(1, mySplit(J), "x", vbTextCompare)
If xPos > 0 Then
'' ROUND SU VALORI single SI COMPORTA MALE!
'' Cells(I, "j").Value = Round(CSng(Left(mySplit(J), xPos - 1)), 3)
'' Cells(I, "k").Value = Round(CSng(Mid(mySplit(J), xPos + 1)), 3)
Cells(I, "j").Value = Round(CDbl(Left(mySplit(J), xPos - 1)), 3)
Cells(I, "k").Value = Round(CDbl(Mid(mySplit(J), xPos + 1)), 4)
Exit For
End If
Next J
Next I
Cells(1, 10) = "no1"
Cells(1, 11) = "no2"
ultima_riga_casa = Sheets("Foglio14").Range("A" & Rows.Count).End(xlUp).Row
''INULTILE:
''andrea = 2
For andrea = 2 To ultima_riga_casa
Cells(andrea, 12) = Round(Cells(andrea, 10), 3)
Cells(andrea, 13) = Round(Cells(andrea, 11), 4)
Next andrea
Sheets("OrdiniVendita").Select
Rows("1:1").Select
Selection.AutoFilter
Sheets("Foglio14").Select
Cells(1, 1).Select
Application.ScreenUpdating = True
'AGGIORNA Origine Dati per TabellaPivot:
pvtsh = "Foglio16"
datash = "Foglio14"
nwrange = datash & "!" & Sheets(datash).Range("A1:M1").Resize(ultima_riga_casa).Address(ReferenceStyle:=xlR1C1)
Sheets(pvtsh).PivotTables(1).ChangePivotCache _
ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=nwrange)
'Aggiorna Pivot
Sheets(pvtsh).PivotTables(1).PivotCache.Refresh
End Sub
Ho lasciato, commentati con doppio Apostrofo a inizio riga, le righe che ho sostituito con le istruzioni che seguono, e ho inserito qualche commento che spiega il motivo della modifica. Tra l'altro ho modificato le istruzioni che facevano l'Arrotondamento, tipo
Cells(I, "j").Value = Round(CSng(Left(mySplit(J), xPos - 1)), 3), perche' l'uso di dati tipo Single manda in tilt l'arrotondamento. Questo, tra l'altro, significa che forse potresti abolire le colonne L:M, che credo hai aggiunto solo per avere le colonne con l'arrotondamento desiderato.
Le modifiche non sono sostanziali, cioe' non cambiano l'approccio della macro composta a partire da quella autoregistrata; col tempo pero' imparerai che alcune operazioni le puoi effettivamente semplificare velocizzando nel contempo la macro.
Ma tra una macro lenta e inefficiente e "nessuna macro" e' ovvio che la mia raccomandazione e' "crea la macro, anche se lenta e inefficiente"
Ciao
Registrazione
