su altro blog stò tirando matto il grande Marius (che non finirò mai di ringraziare) e per non esagerare...vengo a Canossa
Tutto parte da una tua macro che mi ha aiutato oltre ogni limite (http://www.pc-facile.com/forum/viewtopic.php?f=26&t=108413) e precisamente:
- Codice: Seleziona tutto
Sub FormUpdate2()
Dim fCell As Range, aForm As String, oPart As Variant, nPart As Variant
Dim Ws As Worksheet
'
oPart = Application.InputBox(Prompt:="Valore da ELIMINARE:", _
Title:="Cerca e Sostituisci nelle formule", Type:=2)
If Len(oPart) = 0 Or oPart = False Then
MsgBox ("Stringa non valida; la macro viene terminata")
Exit Sub
End If
nPart = Application.InputBox(Prompt:="Valore da Inserire:", _
Title:="Cerca e Sostituisci nelle formule", Type:=2)
If Len(oPart) = 0 Or oPart = False Then
MsgBox ("Stringa non valida; la macro viene terminata")
Exit Sub
End If
'
Dim Rng As Range
Set Rng = Application.InputBox(Prompt:="Selezione intervallo:", _
Title:="Intervallo da modificare", Type:=8)
Application.DisplayAlerts = False
Application.EnableEvents = False
If IsNull(Rng.HasFormula) Or Rng.HasFormula Then 'MMM
For Each fCell In Rng
aForm = fCell.Formula
If InStr(1, aForm, oPart, vbTextCompare) > 0 Then
aForm = Replace(aForm, oPart, nPart, , , vbTextCompare)
fCell.Formula = aForm
End If
DoEvents
Next fCell
End If
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
Volevo implementarla rendendola utilizzabile su più fogli simili nello stesso file.
Con mille e più contributi ed aiuti siamo arrivati a questo:
- Codice: Seleziona tutto
Sub Marius_Gua_Impr()
Dim myRangeMitt As Range
Dim myRangeDest As Range
Dim mese As String, nRighe As Long, cMese As String
Set myRangeMitt = Application.InputBox(Prompt:= _
"Imput Mittente", _
Title:="InputBox Method", Type:=8)
If myRangeMitt Is Nothing Then Exit Sub
Set myRangeDest = Application.InputBox(Prompt:= _
"Imput Destinatario", _
Title:="InputBox Method", Type:=8)
If myRangeDest Is Nothing Then Exit Sub
'copia le righe opportune sia dal Foglio Gua sia dal Foglio Impr
'e le incolla rispettivamente in Gua ed in Impr
'e corregge il nome del mese in entrambi i Fogli
mese = myRangeDest.Value
nRighe = Application.WorksheetFunction.VLookup(mese, Range("AC3:AE14"), 3, 0)
cMese = Application.WorksheetFunction.VLookup(mese, Range("AC3:AE14"), 2, 0)
'cambia il nome del mese nelle formule dei due Fogli
Fgl = "Gua": cc = 0
Application.ScreenUpdating = False
CicloFogli:
With Sheets(Fgl)
Application.CutCopyMode = xlCut
.Select
.Range(Cells(3, 2), Cells(nRighe + 2, 13)).Copy 'copia l'intervallo
.Range(cMese).PasteSpecial 'incolla l'intervallo
'costruisce l'intervallo su cui agire per cambiare il mese
riga = .Range(cMese).Row
Dim Rng As Range
Set Rng = .Range(cMese & ":M" & riga + nRighe - 1)
Application.DisplayAlerts = False
Application.EnableEvents = False
If IsNull(Rng.HasFormula) Or Rng.HasFormula Then 'MMM
For Each fCell In Rng
aForm = fCell.Formula
If InStr(1, aForm, myRangeMitt, vbTextCompare) > 0 Then
aForm = Replace(aForm, myRangeMitt, myRangeDest, , vbTextCompare)
fCell.Formula = aForm
End If
DoEvents
Next fCell
End If
End With
Fgl = "Impr"
If cc = 1 Then GoTo Xit
cc = 1
Set Rng = Nothing
GoTo CicloFogli
Xit:
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
Che funziona correttamente nel file allegato perchè il collegamento è creato ad hoc ed è molto semplice.
Ma nel file master il comportamento cambia. L'idea che mi sono fatto è che mentre la tua sostituisce il testo senza se e senza ma, quella di Mario agganciandosi alle celle , sostituisce il "collegamento", in pratica:
Ovviamente se l'aiuto è risolutivo, vorrei con tuo benestare, postarla anche sull'altro forum per chiudere il cerchio...con dignità!!
https://www.dropbox.com/s/czoqpd8zhd3flig/1_PRODUZ_2017_vMariusV0.xlsm?dl=0
Grazie in anticipo.