ricerca e modifica cella

Salve vorrei sapere se mi potete aiutare a vedere se è possibile fare quanto segue con una macro e aiutarmi in quanto per quanto mi sforzi non ci riesco tutto quello che provo a fare non funziona.
nel file che vado ad allegare ho bisogno che la macro faccia quanto segue:

- in un reticolo che va dalla cella B7 alla cella AM68
- deve effettuare una ricerca per colonna es: B7 B68, poi singolarmente anche su tutte le altre colonne del reticolo
- se nella colonna trova una cella con la lettera H e una con H2 , la cella contenente H venga modificata in H3
- se nella colonna trova una cella con la lettera H e una con H3 , la cella contenente H venga modificata in H2
- se nella colonna trova due celle con la lettera H allora una venga modificata in H2 e l'altra in H3

spero possiate aiutarmi
grazie

ciao
è possibile che si trovino per esempio 2 celle con la H e 1 con la H2 ??

Nel qual caso che deve succedere ?

E se si trovano più combinazioni che corrispondono ai vari criteri?

Ovviamente è solo un esempio, le combinazioni sono molteplici

saluti

No, sulla colonna si possono trovare solo quelle tre varianti, e mai tre celle che contengano H sia da sola che assieme al 2 o al 3, ma sempre due. Ovviamente la macro deve lavorare in tutta la tabella , per riga .
Grazie

fabio70m, 23/07/2022 13:03:

---

.....Ovviamente la macro deve lavorare in tutta la tabella , per riga .
Grazie

---

All'inizio hai detto per colonna......quale delle due?

saluti

Scusa un errore no no per colonna, è che son smontato notte e sono assonnato.

ciao
ho visto che hai postato alle 4,43 !!!!!

Allora, se ho capito questo dovrebbe fare quanto hai richiesto. Magari se lo segui in debug ti rendi conto meglio dell'approccio utilizzato

saluti

Ora sono fuori casa domani mi ci metto, intanto grazie.

Ciao fabio70m,
ma non è simile a quanto avevi richiesto il 25/5? Avevi detto che ti usciva un errore 1004 ma non avevi più risposto per i chiarimenti

duccio.73, 25/07/2022 12:32:

---

Ciao fabio70m,
ma non è simile a quanto avevi richiesto il 25/5? Avevi detto che ti usciva un errore 1004 ma non avevi più risposto per i chiarimenti

---

diciamo che sto cercando di fondere le due macro la seconda fa da completamento alla prima.
per quanto riguarda l'errore 1004 non si è più presentato e non ne so la causa rsto a vedere, spero non si presenti più.
quelcuno mi ha detto di chiudere le discussioni risolte , come faccio?
grazie

duccio.73, 25/07/2022 12:32:

---

Ciao fabio70m,
ma non è simile a quanto avevi richiesto il 25/5? Avevi detto che ti usciva un errore 1004 ma non avevi più risposto per i chiarimenti

---

a completamento della risposta precedente, la macro sembra funzionare alla grande , sei stato gentile e bravissimo, ma posso chiederti come fare il debug passo passo?

ciao
stando nella finestra del vb premi F8 di volta in volta.

saluti

dodo47, 28/07/2022 16:27:

---

ciao
stando nella finestra del vb premi F8 di volta in volta.

saluti

---

grazie , la macro è una bomba

ciao e grazie per il riscontro

saluti

ciao ho unito più macro in una sola per utilizzarla ovviamente come una unica macro, ma mi da errore "errore di compilazione: Dichiarazione doppia nell'area di validità corrente" , alla riga della parte 6 ho aggiunto la parola errore all'inizio, ed ho racchiuso tra parentesi quadre la parete che all'esecuzione mi viene evidenziata da excel per l'errore.

voi riuscite a capire perchè e come risolvere?
grazie


Sub FOLGIO_PRIMA_Coia_e_compila_tutto()
'
' parte 1
' Foglio PRIMA
' Pulsante "Copia da seconda"
' Copia da foglio Seconda , adatta a l contenuto, sotituisce D in D1,
' cambia le D in M,aggiunge le p sotto alle M,cambia H in H2 o H3,
'


'
Sheets("SECONDA").Select
Range("B3:AM3").Select
Selection.Copy
Sheets("PRIMA").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SECONDA").Select
Range("A7:A72").Select
Selection.Copy
Sheets("PRIMA").Select
ActiveWindow.SmallScroll Down:=-21
Range("A7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SECONDA").Select
ActiveWindow.SmallScroll Down:=-57
Range("B7:AM72").Select
Selection.Copy
Sheets("PRIMA").Select
ActiveWindow.SmallScroll Down:=-27
Range("B7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' (Adatta le celle al contenuto)

Range("A1:AM72").Select
ActiveWindow.SmallScroll Down:=-60
Selection.Columns.AutoFit

' parte 2
' (Sostituisce le D con D1)

Range("F7:AM72").Select
Selection.Replace What:="D", Replacement:="D1", lookat:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

' parte 3
' (Cambia le D nelle rispettive M)

Range("F7:AM70").Select
ActiveCell.Replace What:="D1", Replacement:="M1", lookat:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveCell.Replace What:="D1", Replacement:="M1", lookat:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Find(What:="D1", After:=ActiveCell, LookIn:=xlFormulas, lookat:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Cells.Replace What:="D1", Replacement:="M1", lookat:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="D2", Replacement:="M2", lookat:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="D3", Replacement:="M3", lookat:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

' parte 4

'(Aggiunge le P sotto le M)


ur = 72 'ultima riga
uc = 39 'ultima colonna

For j = ur To 2 Step -1
For i = 1 To 39
Select Case Cells(j - 1, i)
Case Is = "M1"
Cells(j, i) = "P1"
Case Is = "M2"
Cells(j, i) = "P2"
Case Is = "M3"
Cells(j, i) = "P3"
End Select
Next i
Next j

' parte 5

'(Cambia le H in H2 0 H3 se prima c'è un 2 o un 3)

For r = 7 To 72 Step 2
For c = 2 To 39
If Cells(r, c).Value = "H" Then
If (Cells(r, c - 2).Value = "M2" Or Cells(r, c - 2).Value = "P2" Or Cells(r + 1, c - 2).Value = "M2" Or Cells(r + 1, c - 2).Value = "P2") Then
Cells(r, c).Value = "H2"
ElseIf (Cells(r, c - 2).Value = "M3" Or Cells(r, c - 2).Value = "P3" Or Cells(r + 1, c - 2).Value = "M3" Or Cells(r + 1, c - 2).Value = "P3") Then
Cells(r, c).Value = "H3"
End If
c = c + 2
End If
Next c
Next r

' parte 6

' PER ORA QUESTA PARTE NON VA nella riga marcata come "errore" viene evidenziata la parte tra le parentesi quadre

' Note: _
le tre variabili H, H2 e H3 sono precedute da: _
m che indica il valore della variabile cercata (=H oppure H2 o H3) _
n che indica la quantità trovata _
p che indica la riga della colonna in esame, dove si trova la var cercata

'Dim mH As String, mH2 As String, mH3 As String, lr As Integer
errore 'Dim mRng As Range,[ c As Integer ], nH As Integer, nH2 As Integer, nH3 As Integer
'Dim pH As Integer, pH2 As Integer, pH3 As Integer
'Dim f As Object, mAdrs As String, k As Byte
'mH = "H"
'mH2 = "H2"
'mH3 = "H3"
'c = 39
'For c = 2 To 39
' Set mRng = Range(Cells(7, c), Cells(68, c))
' nH = Application.WorksheetFunction.CountIf(mRng, mH)
' nH2 = Application.WorksheetFunction.CountIf(mRng, mH2)
' nH3 = Application.WorksheetFunction.CountIf(mRng, mH3)
' If nH > 0 Then
' If nH = 2 Then ' 2 H
' With mRng
' Set f = .Find(mH, LookIn:=xlValues, lookat:=xlWhole)
' If Not f Is Nothing Then
' k = k + 1
' mAdrs = f.Address
' Do
' If k = 1 Then
' Cells(f.Row, c) = mH2
' Else
' Cells(f.Row, c) = mH3
' End If
' k = k + 1
' Set f = .FindNext(f)
' If f Is Nothing Then Exit Do
' Loop While f.Address <> mAdrs
' End If
' End With
' ElseIf nH = 1 And nH2 = 1 Then ' 1 H e 1 H2
' pH = Application.WorksheetFunction.Match(mH, mRng, 0) + 6
' Cells(pH, c) = mH3
' ElseIf nH = 1 And nH3 = 1 Then ' 1 H e 1 H3
' pH = Application.WorksheetFunction.Match(mH, mRng, 0) + 6
' Cells(pH, c) = mH2
' End If
' End If
'Next c
'

End Sub
Sub FOGLIO_PRIMA_CAMBIO_Da_D_a_D1()
' Da_D_a_D1 Macro

' parte 2

' FOGLIO PRIMA
' Non assegnata a nessun pulsante
' fa parete della macro assegnata a pulsante "copia e compila tutto"
' Sostituisce le D con D1


Range("F7:AM72").Select
Selection.Replace What:="D", Replacement:="D1", lookat:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Sub FOGLIO_PRIMA_Da_D_a_M()

' Parte 3

' Da_D_a_M Macro
' ASSEGNATO A FOGLIO PRIMA TASTO 3
' (CAMBIA LE D1 D2 D3 NELLE RISPETTIVE M)
' Controllata funziona correttamente
' Abbinata a foglio "PRIMA"

Range("F7:AM70").Select
ActiveCell.Replace What:="D1", Replacement:="M1", lookat:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveCell.Replace What:="D1", Replacement:="M1", lookat:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Find(What:="D1", After:=ActiveCell, LookIn:=xlFormulas, lookat:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Cells.Replace What:="D1", Replacement:="M1", lookat:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="D2", Replacement:="M2", lookat:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="D3", Replacement:="M3", lookat:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub