Pagina precedente | 1 | Pagina successiva
Vota | Stampa | Notifica email    
Autore

unione di più macro

Ultimo Aggiornamento: 04/08/2022 17:10
Post: 74
Registrato il: 25/05/2015
Età: 53
Utente Junior
2007
OFFLINE
04/08/2022 16:43

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
Post: 1.248
Registrato il: 16/08/2015
Città: CORDENONS
Età: 67
Utente Veteran
Excel 2016-32bit Win11
OFFLINE
04/08/2022 17:10

Dalla segnalazione d'errore sembra che la variabile "c" sia già stata dichiarata ma non la vedo nel codice che hai allegato. Evidentemente è da cercare altrove in quel modulo.

______________________________________________________________
C'è chi fa le COSE a CASO e chi fa CASO alle COSE (Ignoto)
Vota:
Amministra Discussione: | Chiudi | Sposta | Cancella | Modifica | Notifica email Pagina precedente | 1 | Pagina successiva
Nuova Discussione
 | 
Rispondi
Cerca nel forum
Tag discussione
Discussioni Simili   [vedi tutte]
file condiviso (9 messaggi, agg.: 01/06/2017 22:36)
Feed | Forum | Bacheca | Album | Utenti | Cerca | Login | Registrati | Amministra
Tutti gli orari sono GMT+01:00. Adesso sono le 09:27. Versione: Stampabile | Mobile | Regolamento | Privacy
FreeForumZone [v.6.1] - Copyright © 2000-2024 FFZ srl - www.freeforumzone.com