Moderatori: Anthony47, Flash30005
Sub SpostaTest()
Range("C2:AL38").Cut Destination:=Range("B2")
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
CheckArea = "B2:U38"
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then Exit Sub
NumC = Target
If IsNumeric(NumC) And NumC <> "" Then
NN = Target.Row
Call Trova
End If
End If
End Sub
Sub SpostaTest()
Range("C2:AL38").Cut Destination:=Range("B2")
End Sub
Sub Trova()
Application.Calculation = xlManual
Set WsN = Worksheets("Numeri da Inserire")
Set WsT = Worksheets("Tabella riassuntiva")
URN = WsN.Range("B" & Rows.Count).End(xlUp).Row
UCN = WsN.Range("IV2").End(xlToLeft).Column
For FF = 1 To Worksheets.Count
If Worksheets(FF).Name <> WsN.Name And Worksheets(FF).Name <> WsT.Name Then
For CTF = 2 To 38
NumT = Worksheets(FF).Cells(NN, CTF).Value
If NumT = NumC Then
WsT.Cells(FF - 1, CTF).Value = "ok"
End If
Next CTF
End If
Next FF
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Cancella()
Application.EnableEvents = False
Worksheets("Tabella riassuntiva").Range("B2:AL361").ClearContents
Worksheets("Numeri da Inserire").Range("B2:AL361").ClearContents
Application.EnableEvents = True
End Sub
Sub SpostaTest()
Range("C2:AL38").Cut Destination:=Range("B2")
End Sub
Sub Trova()
Range("C2:AL38").Cut Destination:=Range("B2") '<<<<<<<<<<lasciare questa così per spostare le colonna prima dell'elaborazione (esempio1)
Application.Calculation = xlManual
Set WsN = Worksheets("Numeri da Inserire")
Set WsT = Worksheets("Tabella riassuntiva")
URN = WsN.Range("B" & Rows.Count).End(xlUp).Row
UCN = WsN.Range("IV2").End(xlToLeft).Column
For FF = 1 To Worksheets.Count
If Worksheets(FF).Name <> WsN.Name And Worksheets(FF).Name <> WsT.Name Then
For CTF = 2 To 38
NumT = Worksheets(FF).Cells(NN, CTF).Value
If NumT = NumC Then
WsT.Cells(FF - 1, CTF).Value = "ok"
End If
Next CTF
End If
Next FF
'Range("C2:AL38").Cut Destination:=Range("B2") '<<<<<<<<<<togliere il commento a questa riga per spostare le colonna dopo dell'elaborazione - commentare l'altra riga di codice (esempio2)
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Cancella()
Application.EnableEvents = False
Worksheets("Tabella riassuntiva").Range("B2:AL361").ClearContents
Worksheets("Numeri da Inserire").Range("B2:AL361").ClearContents
Application.EnableEvents = True
End Sub
Sub Trova()
Application.Calculation = xlManual
Set WsN = Worksheets("Numeri da Inserire")
Set WsT = Worksheets("Tabella riassuntiva")
URN = WsN.Range("B" & Rows.Count).End(xlUp).Row
UCN = WsN.Range("IV2").End(xlToLeft).Column
For FF = 1 To Worksheets.Count
If Worksheets(FF).Name <> WsN.Name And Worksheets(FF).Name <> WsT.Name Then
Worksheets(FF).Range("C2:AL38").Cut Destination:=Worksheets(FF).Range("B2") '<<<<<<<<<<Inserita qui per tutti i fogli
For CTF = 2 To 38
NumT = Worksheets(FF).Cells(NN, CTF).Value
If NumT = NumC Then
WsT.Cells(FF - 1, CTF).Value = "ok"
End If
Next CTF
End If
Next FF
Application.Calculation = xlCalculationAutomatic
End Sub
max2011 ha scritto: vorrei prima spostare le colonne e poi avviare la macro per la ricerca.
Torna a Applicazioni Office Windows
facebook impossibile aggiornare informazioni account Autore: nikita75 |
Forum: Software Windows Risposte: 1 |
Macro modifica date scelta periodo Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 11 |
Supporto per sviluppo macro VBA Ordinare per data Autore: Carletto Ribolla |
Forum: Applicazioni Office Windows Risposte: 3 |
Inserire add.in nella barra di avvio veloce in excel 2003 Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 4 |
Visitano il forum: Nessuno e 29 ospiti