avevo inserito questa richiesta come risposta ad un altra domanda , ma forse è più utile inserita come nuova domanda, spero di non sbagliare
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