Moderatori: Anthony47, Flash30005
Function pip(ByVal Val As Long, Optional ByVal limite As Long = 90) 'SSSSSSSSSSSSSSSSSIIIIIIIIIIIIII
If Val < 0 Then Val = Val + limite
pip = Val Mod limite
If pip = 0 Then pip = limite
End Function
Public Sub Propo3()
Application.ScreenUpdating = False
Dim numeri(1 To 3) As Long
Dim a As Long
Dim b As Long
Dim n As Integer
Dim arr(1 To 90) As Long
Dim temp As Long
Randomize ' IMPORTANTE
mytim = Timer
Do
Application.ScreenUpdating = False
doCnt = doCnt + 1
' riempie l'array con numeri da 1 a 90
For a = 1 To 90
arr(a) = a
Next a
' mescola l'array
For a = 1 To 90
b = Int(Rnd * 90) + 1
temp = arr(a)
arr(a) = arr(b)
arr(b) = temp
Next a
' prende i primi 3 numeri dell'array mescolato
For a = 1 To 3
numeri(a) = arr(a)
Next a
Range("bh1:bj1") = numeri
On Error Resume Next
If Cells(1, 55) <= Cells(1, 50) Then Exit Do 'SE LA CELLA RIGA 1 COLONNA 55E' <= ALLA CELLA RIGA 1 COLONNA 50 ESCE DALLA MACRO
Loop
Application.ScreenUpdating = True
Debug.Print Format(Timer - mytim, "0.00"), doCnt, Format((Timer - mytim) / doCnt, "0.000")
Beep
Application.ScreenUpdating = True
End Sub
Sub Reformula()
Dim myC As Range, myF As String, Incr As Integer
'
Incr = Range("P1").Value '<<< La cella con l'incremento (+/-) voluto
For Each myC In Range("H4:J12") '<<< L'area da modificare
If myC.HasFormula Then
myF = myC.FormulaLocal
myC.FormulaLocal = Replace(myF, myC.Precedents.Row, myC.Precedents.Row + Incr, , , vbTextCompare)
Debug.Print myF, myC.Formula
End If
Next myC
Debug.Print ">>"
End Sub
papiriof ha scritto:continuo..... dicevo che l'area in cui i numeri delle formule dovrebbero cambiare sarebbe anche BL3:CO20 . Per capire si tenga presente
l'immagine mandata e tenendo presente che sotto esame è la ruota di VEnezia adesso nelle celle CM3,CN3 e CO3 ci sono di seguito le formule CONTA.SE(AW14:BA19;BH3),CONTA.SE(AW14:BA19;BI3 ) e CONTA.SE(AW14:BA19;BJ3). Dove qualora avessi dato corso alla prima macro "Reformula" e avessi messo +1in una nuova macroda fare mi aspetterei CONTA.SE(AW15:BA20;BH3),CONTA.SE([color=#BFBF00]AW15:BA20[/color];BI3 ) e CONTA.SE(AW15:BA20;BJ3 per armonizzare conseguentemente quanto fatto dalla prima macro . non cambierebbe solo i BH3, BI3 e BJ3.
Sub ReFormula2()
Dim cPred As String, cForm As String
Dim mySplit, myC As Range
'
Incr = Range("o1").Value '<<< La cella con l'incremento (+/-) voluto
For Each myC In Range("g4:J10") '<<< L'area da modificare
If myC.HasFormula Then
cPrec = myC.Precedents.Address
cForm = myC.FormulaLocal
If InStr(1, cForm, "pip(", vbTextCompare) > 0 Then
myC.FormulaLocal = Replace(cForm, myC.Precedents.Row, myC.Precedents.Row + Incr, , , vbTextCompare)
Debug.Print myC.Address(0, 0), cForm, " 1-->", myC.FormulaLocal
ElseIf InStr(1, cForm, "conta.se", vbTextCompare) > 0 Then
myC.Formula = Application.ConvertFormula(myC.Formula, xlA1, xlA1, xlAbsolute)
cPrec = myC.Precedents.Address
cForm = myC.FormulaLocal
mySplit = Split(cPrec & ", ", ",", , vbTextCompare)
myC.FormulaLocal = Replace(cForm, mySplit(0), Range(mySplit(0)).Offset(Incr, 0).Address, , , vbTextCompare)
Debug.Print myC.Address(0, 0), cForm, " 2-->", myC.FormulaLocal
Else
Debug.Print myC.Address(0, 0), "????", cForm
End If
End If
Next myC
End Sub
Sub ReFormula2()
Dim cPred As String, cForm As String
Dim mySplit, myC As Range
'
Incr = Range("be1").Value '<<< La cella con l'incremento (+/-) voluto
For Each myC In Range("bh3:cn21") '<<< L'area da modificare
If myC.HasFormula Then
cPrec = myC.Precedents.Address
cForm = myC.FormulaLocal
If InStr(1, cForm, "pip(", vbTextCompare) > 0 Then
myC.FormulaLocal = Replace(cForm, myC.Precedents.Row, myC.Precedents.Row + Incr, , , vbTextCompare)
Debug.Print myC.Address(0, 0), cForm, " 1-->", myC.FormulaLocal
ElseIf InStr(1, cForm, "conta.se", vbTextCompare) > 0 Then
myC.Formula = Application.ConvertFormula(myC.Formula, xlA1, xlA1, xlAbsolute)
cPrec = myC.Precedents.Address
cForm = myC.FormulaLocal
mySplit = Split(cPrec & ", ", ",", , vbTextCompare)
myC.FormulaLocal = Replace(cForm, mySplit(0), Range(mySplit(0)).Offset(Incr, 0).Address, , , vbTextCompare)
Debug.Print myC.Address(0, 0), cForm, " 2-->", myC.FormulaLocal
Else
Debug.Print myC.Address(0, 0), "????", cForm
End If
End If
Next myC
End Sub
Sub ReFormula3()
Dim cForm As String, Incr As Long
Dim mySplit, myC As Range, kREF As String, Caso As Long
'
Incr = Range("be1").Value '<<< La cella con l'incremento (+/-) voluto
For Each myC In Range("bh3:cn21") '<<< L'area da modificare
If myC.HasFormula Then
cForm = myC.FormulaLocal
If InStr(1, cForm, "pip(", vbTextCompare) > 0 Then
Caso = 1
kREF = GimmeRef(cForm, "(", "+")
ElseIf InStr(1, cForm, "conta.se", vbTextCompare) > 0 Then
Caso = 2
kREF = GimmeRef(cForm, "se(", ";")
Else
Caso = 3
End If
If Caso < 3 And Len(kREF) > 1 Then
myC.FormulaLocal = Replace(cForm, kREF, Range(kREF).Offset(1, 0).Address, , , vbTextCompare)
Debug.Print myC.Address(0, 0), cForm, "Caso=" & Caso, myC.FormulaLocal
Else
Debug.Print myC.Address(0, 0), cForm, "Caso=" & Caso, "------"
End If
End If
Next myC
End Sub
Function GimmeRef(ByVal lForm As String, ByVal iStr As String, ByVal eStr As String) As String
Dim iPos As Long, ePos As Long
'
iPos = InStr(1, lForm, iStr, vbTextCompare)
ePos = InStr(1, lForm, eStr, vbTextCompare)
If (iPos * ePos) > 0 Then
GimmeRef = Mid(lForm, iPos + Len(iStr), ePos - iPos - Len(iStr))
End If
End Function
vabene ma....... nella cella con l'incremento (+/-) voluto BE1 funziona solo in positivo per cui se metto 1 tutta la faccenda dei riferimenti giustamente aumenta di 1 ma se dopo voglio ritornare indietro mettenndo -1 va ancora avanti di uno è come se ignorasse il "-"
myC.FormulaLocal = Replace(cForm, kREF, Range(kREF).Offset(1, 0).Address, , , vbTextCompare)
Inoltre essendo le estrazioni di mese in mese diverse (ci sono mesi con minimo 12 e massimo 14 estrazioni) sarebbe opportuno considerare questo inconveniente e mettere una user form per mettere che richieda da che data (estrazione) decorrono le sei estrazioni da porre in esame
=SOMMA(CONTA.SE(D3:H3;BH1:BJ1))
Anthony47 ha scritto:Le formule in CS3 e successive guardano a un blocco di estrazioni, non una singola.
se vuoi contare quanti numeri di un elenco (es i tre numeri in BH1:BJ1) sono presenti in una singola estrazione devi usare una formula del tipo
=Somma(Conta.se(Estrazione;MieiNumeri)
Esempio
- Codice: Seleziona tutto
=SOMMA(CONTA.SE(D3:H3;BH1:BJ1))
Da confermare con Contr-Maiusc-Enter; un ambo corrisponde al risultato "2"
Torna a Applicazioni Office Windows
Aumenta altezza riga in base valore cella Autore: trittico69 |
Forum: Applicazioni Office Windows Risposte: 28 |
acqistata ram nuova ,ma il pc non parte,cosa sara? Autore: anm2004 |
Forum: Assistenza Hardware Risposte: 5 |
Velocizzare ordinamento di tante righe con valori e formule Autore: ricky53 |
Forum: Applicazioni Office Windows Risposte: 2 |
cerca il più grande numero di celle vuote in un intervallo Autore: papiriof |
Forum: Applicazioni Office Windows Risposte: 2 |
colora parte di frase/ Parola in stessa cella Autore: raimea |
Forum: Applicazioni Office Windows Risposte: 6 |
Visitano il forum: Nessuno e 15 ospiti