come da titolo vorrei copiare degli intervalli di dati (estrazioni del lotto) provo con We Trasfer a inviare un piccolo file dove sono più esplicito
https://we.tl/t-2hf36G17AJ
Moderatori: Anthony47, Flash30005
Anthony47 ha scritto:Nell'allegato chiedi una macro "che mi deve caricare 10 intervalli di 8 estrazioni di una ruota con i riferimenti che io indico in "D2" "D3" e "D4" e che si evincono dal foglio Archivio. Questo è un esempio reale dove scelgo di esaminare 10 mesi della ruota di bari relativamente a 8 estrazz. consecutive e che partono sempre dalla 2^ estraz del mese . Se in D3 metto 3 la macro agirà di conseguenza"
Poi in D3 scrivi 2 e in D4 scrivi 9933; i due dati sono congruenti, cioe' l'estrazione 9933 e' la 2^ (di giugno 2021)
Ma se D3 e D4 non sono congruenti, quale input deve essere prevalente? Perche' invece di scrivere un estrazione (es 9933) non ti limiti a scrivere mese/anno e lasci a D3 l'indicazione di quale estrazione prelevare?
Ciao
Sub Get10A()
Dim iDate As Date, mInd As Long, lWhee As String, hOff
Dim StaMes, ArSh As Worksheet, StaRow As Long, I As Long
'
Sheets("Freq_Deter").Select
Set ArSh = Sheets("Archivio")
'
lWhee = Range("D2").Value
mInd = Range("D3").Value
StaRow = 7
Cells(StaRow, 1).Resize(1000, 11).ClearContents
hOff = Application.Match(lWhee, ArSh.Range("A2").Resize(1, 100), False)
If Not IsError(hOff) Then
For I = 1 To 10
iDate = Application.WorksheetFunction.EoMonth(Range("D4").Value, I - 2) + 1
StaMes = Application.Match(CLng(iDate), ArSh.Range("C:C"))
If StaMes <= staold Then
StaMes = "Incompleto, " & (I - 1) & " su 10"
GoTo mErr
End If
StaMes = StaMes + mInd - 1
Cells(StaRow + 13 * I - 13, 1).Resize(8, 3).Value = ArSh.Cells(StaMes, 1).Resize(8, 3).Value
Cells(StaRow + 13 * I - 13, 6).Resize(8, 5).Value = ArSh.Cells(StaMes, hOff).Resize(8, 5).Value
staold = StaMes
Next I
MsgBox ("Completato...")
Exit Sub
End If
mErr:
If IsError(hOff) Then hOff = "Manca " & lWhee Else hOff = "Ok"
MsgBox ("Non completato" & vbCrLf & "Ruota: " & hOff & vbCrLf & "Riga: " & StaMes)
End Sub
Sub Get10A()
Dim iDate As Date, mInd As Long, lWhee As String, hOff
Dim StaMes, ArSh As Worksheet, StaRow As Long, I As Long
'
Sheets("Freq_Deter").Select
Set ArSh = Sheets("Archivio") ''''''' Sia "ArSh" come il foglio "Arcchivio"
'
lWhee = Range("D2").Value ' ''''' la ruota
mInd = Range("D3").Value ''''''' l'indice mensile
StaRow = 7 ''''''''''' riga inizio dei dati
Cells(StaRow, 1).Resize(1000, 11).ClearContents '''''pulisco l'intervallo di celle A7:k1000
hOff = Application.Match(lWhee, ArSh.Range("A2").Resize(1, 100), False)
If Not IsError(hOff) Then
For I = 1 To 10
iDate = Application.WorksheetFunction.EoMonth(Range("D4").Value, I - 2) + 1
' non capisco cosa fa il valore che fa che metto in D4
StaMes = Application.Match(CLng(iDate), ArSh.Range("C:C"))
If StaMes <= staold Then
StaMes = "Incompleto, " & (I - 1) & " su 10"
GoTo mErr
End If
StaMes = StaMes + mInd - 1
Cells(StaRow + 13 * I - 13, 1).Resize(8, 3).Value = ArSh.Cells(StaMes, 1).Resize(8, 3).Value
Cells(StaRow + 13 * I - 13, 6).Resize(8, 5).Value = ArSh.Cells(StaMes, hOff).Resize(8, 5).Value
staold = StaMes
Next I
MsgBox ("Completato...")
Exit Sub
End If
mErr:
If IsError(hOff) Then hOff = "Manca " & lWhee Else hOff = "Ok"
MsgBox ("Non completato" & vbCrLf & "Ruota: " & hOff & vbCrLf & "Riga: " & StaMes)
End Sub
Sub Get10A()
Dim iDate As Date, mInd As Long, lWhee As String, hOff
Dim StaMes, ArSh As Worksheet, StaRow As Long, I As Long
'
Sheets("Freq_Deter").Select
Set ArSh = Sheets("Archivio") ''''''' Sia "ArSh" come il foglio "Arcchivio"
'
lWhee = Range("D2").Value ' ''''' la ruota
mInd = Range("D3").Value ''''''' l'indice mensile
StaRow = 7 ''''''''''' riga inizio dei dati
Cells(StaRow, 1).Resize(1000, 11).ClearContents '''''pulisco l'intervallo di celle A7:k1000
hOff = Application.Match(lWhee, ArSh.Range("A2").Resize(1, 100), False)
If Not IsError(hOff) Then
For I = 1 To 10
iDate = Application.WorksheetFunction.EoMonth(Range("D4").Value, I - 2) + 1
' non capisco cosa fa il valore che fa che metto in D4
StaMes = Application.Match(CLng(iDate), ArSh.Range("C:C"))
If StaMes <= staold Then
StaMes = "Incompleto, " & (I - 1) & " su 10"
GoTo mErr
End If
StaMes = StaMes + mInd - 1
Cells(StaRow + 13 * I - 13, 1).Resize(8, 3).Value = ArSh.Cells(StaMes, 1).Resize(8, 3).Value
Cells(StaRow + 13 * I - 13, 6).Resize(8, 5).Value = ArSh.Cells(StaMes, hOff).Resize(8, 5).Value
staold = StaMes
Next I
MsgBox ("Completato...")
Exit Sub
End If
mErr:
If IsError(hOff) Then hOff = "Manca " & lWhee Else hOff = "Ok"
MsgBox ("Non completato" & vbCrLf & "Ruota: " & hOff & vbCrLf & "Riga: " & StaMes)
End Sub
For I = 1 To 10
iDate = Application.WorksheetFunction.EoMonth(Range("D4").Value, I - 2) + 1
StaMes = Application.Match(CLng(iDate), ArSh.Range("C:C"))
If ArSh.Cells(StaMes, 3).Value < iDate Then StaMes = StaMes + 1 '<<< QUESTA!
If StaMes <= staold Then
'etc
'etc
Torna a Applicazioni Office Windows
Intervalli non contigui incolla da un foglio ad un altro Autore: papiriof |
Forum: Applicazioni Office Windows Risposte: 6 |
icone scompaiono dalla barra degli strumenti in win11 Autore: wallace&gromit |
Forum: Sistemi Operativi Windows Risposte: 5 |
Excel formula conta.se intervalli variabili da valore cella Autore: Statix |
Forum: Applicazioni Office Windows Risposte: 7 |
Visitano il forum: Nessuno e 15 ospiti