Moderatori: Anthony47, Flash30005
Sub XYZ3()
Dim deSh As String, I As Long, NextC As Long
Dim GiaIn As Long, CArr
'
Sheets("Foglio1").Select '<<< Il Foglio con i dati di partenza
For I = 171 To 173
deSh = Cells(6, I)
If Len(deSh) = 1 And InStr(1, "XYZ", deSh, vbTextCompare) > 0 Then
With Sheets(deSh)
GiaIn = Application.WorksheetFunction.CountA(.Range("e6").Resize(1, 10000))
If GiaIn > 0 Then
CArr = .Range(.Range("E6"), .Range("E6").End(xlDown)).Resize(, GiaIn + 1).Value
.Range(.Range("E6"), .Range("E6").End(xlDown)).ClearContents
.Range("F6").Resize(UBound(CArr), UBound(CArr, 2)) = CArr
End If
NextC = 5
Range(Cells(6, I), Cells(6, I).End(xlDown)).Copy .Cells(6, NextC)
End With
End If
Next I
End Sub
Mi risulta che da copiare sia un elenco in colonna, non un solo elemento; per cui mi risulta difficile capire cosa intendi.per esempio se l ultimo valore memorizzato fosse 2 e al successivo aggiornamento è di nuovo 2 lo ignora...se diverso lo scrive..
Interpreto questa risposta come "Si si, basta limitarsi a controllare il contenuto della prima cella"Si si..l esempio era x farmi capire..ma dovrebbe valere per tutti i dati xyz in colonna presenti
Sub XYZ4()
Dim deSh As String, I As Long, NextC As Long
Dim GiaIn As Long, CArr
'
Sheets("Foglio1").Select '<<< Il Foglio con i dati di partenza
For I = 171 To 173
deSh = Cells(6, I)
If Len(deSh) = 1 And InStr(1, "XYZ", deSh, vbTextCompare) > 0 Then
With Sheets(deSh)
GiaIn = Application.WorksheetFunction.CountA(.Range("e6").Resize(1, 10000))
If Cells(7, I) <> .Range("E7") Then
If GiaIn > 0 Then
CArr = .Range(.Range("E6"), .Range("E6").End(xlDown)).Resize(, GiaIn + 1).Value
.Range(.Range("E6"), .Range("E6").End(xlDown)).ClearContents
.Range("F6").Resize(UBound(CArr), UBound(CArr, 2)) = CArr
End If
NextC = 5
Range(Cells(6, I), Cells(6, I).End(xlDown)).Copy .Cells(6, NextC)
End If
End With
End If
Next I
End Sub
Basta descriverlo bene... Perche' se io chiedo "Basta confrontare allora la prima cella? Quella su riga 7, per intenderci. O che cosa?" e tu rispondi "Si si..l esempio era x farmi capire..ma dovrebbe valere per tutti i dati xyz in colonna presenti" allora significa che basta controllare la riga 7; a me sembra chiaro.ho preparato un esempio per simulare cosa dovrebbe fare...perchè mi rendo conto che non è facile da capire descrivendolo...
Sub XYZ5()
Dim deSh As String, I As Long, J As Long
'
Sheets("Foglio1").Select '<<< Il Foglio con i dati di partenza
For I = 171 To 173
deSh = Cells(6, I)
If Len(deSh) = 1 And InStr(1, "XYZ", deSh, vbTextCompare) > 0 Then
With Sheets(deSh)
For J = 0 To Range(Cells(7, I), Cells(7, I).Offset(1000, 0).End(xlUp)).Rows.Count - 1
If Cells(7 + J, I) <> .Cells(7 + J, 5) Then
.Cells(7 + J, 5).Insert Shift:=xlToRight
.Cells(7 + J, 5) = Cells(7 + J, I)
End If
Next J
End With
End If
Next I
End Sub
Sub XYZ5bis()
Dim deSh As String, I As Long, J As Long
Dim sArr
'
Application.Calculation = xlCalculationManual
mytim = Timer
Sheets("Foglio1").Select '<<< Il Foglio con i dati di partenza
For I = 171 To 173
deSh = Cells(6, I)
If Len(deSh) = 1 And InStr(1, "XYZ", deSh, vbTextCompare) > 0 Then
With Sheets(deSh)
For J = 0 To Range(Cells(7, I), Cells(7, I).Offset(1000, 0).End(xlUp)).Rows.Count - 1
If Cells(7 + J, I) <> .Cells(7 + J, 5) Then
If Application.WorksheetFunction.CountA(.Cells(7 + J, 5).Resize(1, 2)) > 0 Then
sArr = .Range(.Cells(7 + J, 5), .Cells(7 + J, Columns.Count).End(xlToLeft).Offset(0, 1)).Value
.Cells(7 + J, 6).Resize(1, UBound(sArr, 2)) = sArr
End If
.Cells(7 + J, 5) = Cells(7 + J, I)
End If
Next J
End With
End If
Next I
'MsgBox (Format(Timer - mytim, "0.00"))
Application.Calculation = xlCalculationAutomatic
End Sub
Succede anche con l'ultima macro, la Sub XYZ5bis?ho notato che a ogni inserimento i riferimenti delle formule vengono sfalsati
Torna a Applicazioni Office Windows
Problema con copia dati senza formattazione Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 2 |
Errore 1004 su macro salva file come mht - mhtml Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 4 |
Macro copia dati colonne non contigue su un altro file excel Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 5 |
Visitano il forum: Nessuno e 27 ospiti