attivazione macro ad evento

Hai un problema con Excel?

Nuova discussione

attivazione macro ad evento
di MCFLOWER (utente non iscritto) data: 17/09/2015 12:21:15
Buongiorno a tutti,
avrei la necessità di far partire una macro se il numero di celle valorizzate nella colonna A è uguale al numero di celle della colonna B, la parte in cui non riesco e far in modo che se la formula non trova l'uguaglianza si interrompa per riprendere solo quando l'operatore ha inserito tutti i dati...come potrei fare?
grazie mille
di alfrimpa data: 17/09/2015 12:48:09
Ciao McFlower

Così a naso direi che dovresti utilizzare l'evento Change dell'oggetto Worksheet (Worksheet_Change).

Ma se alleghi un file spiegando quello che vuoi ottenere è decisamente meglio.

Alfredo

di MCFLOWER (utente non iscritto) data: 17/09/2015 13:49:15
Ciao Alfredo, grazie per la risposta i due codici generati sono quelli che vi riporto avrei necessità in sostanza che la parte di comandi di processo verifica finale parte solo dopo che l'operatore abbi terminato di importare alcuni dati sul foglio di calcolo.
e pensavo che potesse essere utile come idea fare una macro che mi verificasse se il numero di celle in A valorizzate fosse uguale a quello nella colonna B, se invece possono esistere altre soluzioni meglio...il numero di celle valorizzato è variabile....

Sub Pulsante12_Click()
'
' Pulsante Creazione Massive
'

' Filtro Dati più Estrazione Campi per creazione massive

    
    Windows("Slot Provvisorio.xlsx").Activate
    Rows("1:1").Select
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    
    
    ActiveWindow.FreezePanes = True
    Selection.AutoFilter
    ActiveWindow.Zoom = 85
    ActiveWindow.LargeScroll ToRight:=-1
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 1
    ActiveSheet.Range("$A$1:$AK$5823").AutoFilter Field:=1, Criteria1:="=*c", Operator:=xlAnd
    ActiveSheet.Range("$A$1:$AK$5823").AutoFilter Field:=7, Criteria1:="00 - Open"
    ActiveSheet.Range("$A$1:$AK$5823").AutoFilter Field:=10, Criteria1:="A"
     
    
    
    
Cells.Find(What:="data prossima proposta", After:=ActiveCell, LookIn:= _
        xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Activate
        
            Dim campo As Integer
campo = ActiveCell.Column - ActiveCell.End(xlToLeft).Column + 1
ActiveCell.AutoFilter Field:=campo, Criteria1:=xlFilterNextWeek, Operator:=xlFilterDynamic

    
    ActiveWindow.LargeScroll ToRight:=-1
    ActiveWindow.ScrollColumn = 1
    Range("A:A,B:B,H:H,K:K,N:N").Select
    Range("N1").Activate
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    ActiveWindow.Zoom = 85
    Columns("A:E").Select
    Columns("A:E").EntireColumn.AutoFit
    Range("F1").Select
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ColorIndex = 40
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.NumberFormat = "General"
    ActiveCell.FormulaR1C1 = "pct az"
    Range("G1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ColorIndex = 40
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.NumberFormat = "General"
    ActiveCell.FormulaR1C1 = "referente"
    Range("H1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ColorIndex = 40
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.NumberFormat = "General"
    ActiveCell.FormulaR1C1 = "sessione"
    Range("F2").Select
    Windows("Estrazione azionario.xlsx").Activate
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("Slot Provvisorio.xlsx").Activate
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    Sheets("Foglio1").Select
    
    Application.CutCopyMode = False
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-5],Foglio2!C[-5]:C[-1],5,FALSE)"
    Range("f2").Select
    ActiveSheet.Range("e2").End(xlDown).Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
       ActiveWindow.ScrollRow = 1
    Selection.FillDown
    
     
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],[Aree_2013.xlsx]Aree!C1:C5,5,FALSE)"
    Range("G2").Select
    ActiveSheet.Range("e2").End(xlDown).Offset(0, 2).Select
    Range(Selection, Selection.End(xlUp)).Select
       ActiveWindow.ScrollRow = 1
    Selection.FillDown
 
            
'Formula suddivisione ptf
       
            Windows("Slot Provvisorio.xlsx").Activate
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-2]=""#N/D"",""#N/D"",IF(RC[-5]<750000,IF(OR(RC[-4]=""PC2MO"",RC[-4]=""PC1PR""),""UCM"",""UDA""),IF(RC[-4]=""PC2MO"",IF(RC[-2]<22,""BCM"",IF(OR(LEFT(RC[-1],2)=""BR"",LEFT(RC[-1],2)=""CA"",LEFT(RC[-1],2)=""DI"",LEFT(RC[-1],2)=""FA""),""CMA"",""CMB"")),IF(RC[-4]=""PC1PR"",IF(OR(LEFT(RC[-1],2)=""BR"",LEFT(RC[-1],2)=""CA"",LEFT(RC[-1],2)=""DI"",LEFT(RC[-1],2)=""FA""),""CMA"",""CMB""),IF(RC[-4]=""PC3DI"",IF(RC[-2]<52,""BDA"",""DA""),""BDA"")))))"
    Range("H2").Select
    ActiveSheet.Range("e2").End(xlDown).Offset(0, 3).Select
    Range(Selection, Selection.End(xlUp)).Select
       ActiveWindow.ScrollRow = 1
    Selection.FillDown
    
    Columns("F:G").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
'Nomenclatura Folder

    Windows("Slot Provvisorio.xlsx").Activate
    Sheets("Foglio1").Select
    Sheets("Foglio1").Name = "Sessione"
    Sheets("Foglio2").Select
    Sheets("Foglio2").Name = "Pct Azionaria"
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("Foglio3").Select
    Sheets("Foglio3").Name = "Verifica"
    
'Conteggio ptf per sessione
    
    Windows("Slot Provvisorio.xlsx").Activate
    Sheets("Sessione").Select
    Range("J3").Select
    ActiveCell.FormulaR1C1 = "CMA"
    Range("J4").Select
    ActiveCell.FormulaR1C1 = "CMB"
    Range("J5").Select
    ActiveCell.FormulaR1C1 = "BCM"
    Range("J6").Select
    ActiveCell.FormulaR1C1 = "DA"
    Range("J7").Select
    ActiveCell.FormulaR1C1 = "BDA"
    Range("J8").Select
    ActiveCell.FormulaR1C1 = "UCM"
    Range("J9").Select
    ActiveCell.FormulaR1C1 = "UDA"
    Range("J10").Select
    ActiveCell.FormulaR1C1 = "#N/D"
    Range("K3:K10").Select
    Selection.FormulaR1C1 = "=COUNTIF(C[-3],RC[-1])"
    Range("k12").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-8]C:R[-1]C)"
    
   Sheets("sessione").Activate
    Rows("1:1").Select
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    
    
    ActiveWindow.FreezePanes = True
    Selection.AutoFilter
    
    


If Range("K10") > 0 Then
MsgBox ("ATTENZIONE PTF NON PRESENTI IN ESTRAZIONE AZ")


    ActiveSheet.Range("$A$1:$f$5823").AutoFilter Field:=6, Criteria1:="#N/D"

Dim cell As Range
LR = Cells(Rows.Count, "F").End(xlUp).Row
For Each cell In Range("F2:F" & LR)
  If Application.WorksheetFunction.IsNA(cell) Then
    s = InputBox("Inserire l'esposizione azionaria del ptf")
    cell.Value = s
  End If
Next


End If

Rows("1:1").Select
    Selection.AutoFilter










'Apertura file sessioni e cancella contenuti a partire da riga 4
'

'
  ChDir _
        "T:InvAmm\Creazioni Massivesessioni"
    Workbooks.Open Filename:= _
        "T:InvAmm\Creazioni MassivesessioniBCM.xls"
    Workbooks.Open Filename:= _
        "T:InvAmm\Creazioni MassivesessioniBDA.xls"
    Workbooks.Open Filename:= _
        "T:InvAmm\Creazioni MassivesessioniCMA.xls"
    Workbooks.Open Filename:= _
       "T:InvAmm\Creazioni MassivesessioniCMB.xls"
    Workbooks.Open Filename:= _
        "T:InvAmm\Creazioni MassivesessioniDA.xls"
    Workbooks.Open Filename:= _
        "T:InvAmm\Creazioni MassivesessioniUCM.xls"
    Workbooks.Open Filename:= _
        "T:InvAmm\Creazioni MassivesessioniUDA.xls"
    Application.Run "ConnectChartEvents"
    Application.Run "ConnectChartEvents"
    Application.Run "ConnectChartEvents"
    Application.Run "ConnectChartEvents"
    Application.Run "ConnectChartEvents"
    Application.Run "ConnectChartEvents"
    Application.Run "ConnectChartEvents"
    
    Windows("UDA.xls").Activate
    Range("A4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Range("a4").Select
    Windows("UCM.xls").Activate
    Range("A4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Range("a4").Select
    Windows("DA.xls").Activate
    Range("A4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Range("a4").Select
    Windows("CMB.xls").Activate
    Range("A4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Range("a4").Select
    Windows("CMA.xls").Activate
    Range("A4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Range("a4").Select
    Windows("BDA.xls").Activate
    Range("A4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Range("A4").Select
    Windows("BCM.xls").Activate
    Range("A4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Range("A4").Select
'
' Estrazione valori per singola sessione e copia nel singolo file

 ' selezione dei dati da copiare nelle singole sessioni
    
'UCM
 
    Application.ScreenUpdating = False
LR1 = Workbooks("Slot Provvisorio").Sheets("Sessione").Cells(Rows.Count, "A").End(xlUp).Row
LR2 = Workbooks("UCM").Sheets("Dossier").Cells(Rows.Count, "A").End(xlUp).Row + 1

With Workbooks("Slot Provvisorio").Sheets("Sessione")
    For r = 1 To LR1
        If .Cells(r, 8).Value = "UCM" Then
            .Range(.Cells(r, 1), .Cells(r, 1)).Copy Workbooks("UCM").Sheets("Dossier").Cells(LR2, 1)
            LR2 = LR2 + 1
        End If
    Next
  End With
Application.ScreenUpdating = True

'UDA
Application.ScreenUpdating = False
LR1 = Workbooks("Slot Provvisorio").Sheets("Sessione").Cells(Rows.Count, "A").End(xlUp).Row
LR2 = Workbooks("UDA").Sheets("Dossier").Cells(Rows.Count, "A").End(xlUp).Row + 1

With Workbooks("Slot Provvisorio").Sheets("Sessione")
    For r = 1 To LR1
        If .Cells(r, 8).Value = "UDA" Then
            .Range(.Cells(r, 1), .Cells(r, 1)).Copy Workbooks("UDA").Sheets("Dossier").Cells(LR2, 1)
            LR2 = LR2 + 1
        End If
    Next
  End With
Application.ScreenUpdating = True

'BDA
Application.ScreenUpdating = False
LR1 = Workbooks("Slot Provvisorio").Sheets("Sessione").Cells(Rows.Count, "A").End(xlUp).Row
LR2 = Workbooks("BDA").Sheets("Dossier").Cells(Rows.Count, "A").End(xlUp).Row + 1

With Workbooks("Slot Provvisorio").Sheets("Sessione")
    For r = 1 To LR1
        If .Cells(r, 8).Value = "BDA" Then
            .Range(.Cells(r, 1), .Cells(r, 1)).Copy Workbooks("BDA").Sheets("Dossier").Cells(LR2, 1)
            LR2 = LR2 + 1
        End If
    Next
  End With
Application.ScreenUpdating = True

'DA

Application.ScreenUpdating = False
LR1 = Workbooks("Slot Provvisorio").Sheets("Sessione").Cells(Rows.Count, "A").End(xlUp).Row
LR2 = Workbooks("DA").Sheets("Dossier").Cells(Rows.Count, "A").End(xlUp).Row + 1

With Workbooks("Slot Provvisorio").Sheets("Sessione")
    For r = 1 To LR1
        If .Cells(r, 8).Value = "DA" Then
            .Range(.Cells(r, 1), .Cells(r, 1)).Copy Workbooks("DA").Sheets("Dossier").Cells(LR2, 1)
            LR2 = LR2 + 1
        End If
    Next
  End With
Application.ScreenUpdating = True

'BCM
Application.ScreenUpdating = False
LR1 = Workbooks("Slot Provvisorio").Sheets("Sessione").Cells(Rows.Count, "A").End(xlUp).Row
LR2 = Workbooks("BCM").Sheets("Dossier").Cells(Rows.Count, "A").End(xlUp).Row + 1

With Workbooks("Slot Provvisorio").Sheets("Sessione")
    For r = 1 To LR1
        If .Cells(r, 8).Value = "BCM" Then
            .Range(.Cells(r, 1), .Cells(r, 1)).Copy Workbooks("BCM").Sheets("Dossier").Cells(LR2, 1)
            LR2 = LR2 + 1
        End If
    Next
  End With
Application.ScreenUpdating = True

'CMB
Application.ScreenUpdating = False
LR1 = Workbooks("Slot Provvisorio").Sheets("Sessione").Cells(Rows.Count, "A").End(xlUp).Row
LR2 = Workbooks("CMB").Sheets("Dossier").Cells(Rows.Count, "A").End(xlUp).Row + 1

With Workbooks("Slot Provvisorio").Sheets("Sessione")
    For r = 1 To LR1
        If .Cells(r, 8).Value = "CMB" Then
            .Range(.Cells(r, 1), .Cells(r, 1)).Copy Workbooks("CMB").Sheets("Dossier").Cells(LR2, 1)
            LR2 = LR2 + 1
        End If
    Next
  End With
Application.ScreenUpdating = True

'CMA
Application.ScreenUpdating = False
LR1 = Workbooks("Slot Provvisorio").Sheets("Sessione").Cells(Rows.Count, "A").End(xlUp).Row
LR2 = Workbooks("CMA").Sheets("Dossier").Cells(Rows.Count, "A").End(xlUp).Row + 1

With Workbooks("Slot Provvisorio").Sheets("Sessione")
    For r = 1 To LR1
        If .Cells(r, 8).Value = "CMA" Then
            .Range(.Cells(r, 1), .Cells(r, 1)).Copy Workbooks("CMA").Sheets("Dossier").Cells(LR2, 1)
            LR2 = LR2 + 1
        End If
    Next
    MsgBox "upload completato, SALVARE le sessioni nella cartella dello slot in lavorazione"
  End With
Application.ScreenUpdating = True



' processo di verifica finale



        
Windows("Schema_prod.xlsx").Activate
    Rows("1:1").Select
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    
    
    ActiveWindow.FreezePanes = True
    Selection.AutoFilter
    ActiveWindow.Zoom = 85
    ActiveWindow.LargeScroll ToRight:=-1
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 1
    ActiveSheet.Range("$A$1:$AK$5823").AutoFilter Field:=1, Criteria1:="=*c", Operator:=xlAnd
    ActiveSheet.Range("$A$1:$AK$5823").AutoFilter Field:=7, Criteria1:="00 - Open"
    ActiveSheet.Range("$A$1:$AK$5823").AutoFilter Field:=10, Criteria1:="A"
     
    
    
    
Cells.Find(What:="data prossima proposta", After:=ActiveCell, LookIn:= _
        xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Activate
        
            Dim campo1 As Integer
campo1 = ActiveCell.Column - ActiveCell.End(xlToLeft).Column + 1
ActiveCell.AutoFilter Field:=campo, Criteria1:=xlFilterNextWeek, Operator:=xlFilterDynamic

Windows("schema_prod.xlsx").Activate
    Range("A1:B1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("Slot Provvisorio.xlsx").Activate
    Sheets("Verifica").Select
    Range("E1").Select
    ActiveSheet.Paste
    Range("D2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],R2C5:R423C5,1,FALSE)"
    Range("D2").Select
    ActiveSheet.Range("C2").End(xlDown).Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
       ActiveWindow.ScrollRow = 1
    Selection.FillDown


End Sub

di alfrimpa data: 17/09/2015 13:58:38
Ciao MCFLOWER

Non entro nel merito del codice da te postato (peraltro assai lungo e complesso e per me difficile da capire) ma non puoi usare la funzione CONTA.VALORI() per la colonna A e la colonna B e verificare se i due valori sono uguali.

Potresti mettere tali funzioni in due celle del foglio e fare il controllo su quelle.

Se vuoi usare VBA l'istruzione è:

Application.WorksheetFunctions.CountA(Range("A:A")) per la colonna A.

Ma forse la faccio troppo facile

Alfredo
di Vecchio Frac data: 17/09/2015 14:03:31
Ecco, magari era meglio allegare un file di esempio :o)
di alfrimpa data: 17/09/2015 14:04:54
Infatti l'avevo già chiesto da prima.
di Vecchio Frac data: 17/09/2015 14:28:55
Viviamo in un mondo verboso ^_^

Vuoi Approfondire?