› Excel e gli applicativi Microsoft Office › Sfida numero 3: numeri primi gemelli
-
AutoreArticoli
-
Per questa sfida (proposta da Albatros54) parliamo della solitudine dei numeri primi.
I numeri primi possono essere separati da milioni e milioni di numeri o anche da uno solo; in ogni caso, non si toccano (sfiorano) mai, a parte il 2 e il 3. Cioè c'è sempre almeno un numero in mezzo a due numeri primi. Questo fatto è servito da metafora per dare il titolo ad un classico della letteratura recente, "La solitudine dei numeri primi", di Paolo Giordano.
In uno dei paragrafi del romanzo si esplicita questa metafora: "...In un corso del primo anno Mattia aveva studiato che tra i numeri primi ce ne sono alcuni ancora più speciali. I matematici li chiamano primi gemelli: sono coppie di numeri primi che se ne stanno vicini, anzi, quasi vicini, perché fra di loro vi è sempre un numero pari che impedisce loro di toccarsi per davvero.
Numeri come l'11 e il 13 , come il 17 e il 19 , il 41 e il 43, ... Mattia pensava che lui ed Alice erano cosi, due primi gemelli, soli e perduti, vicini ma non abbastanza per sfiorarsi davvero."Ecco lo spunto per la sfida numero 3: "Trovare tutti i numeri primi gemelli che si trovano nei primi diecimila numeri interi".
Forse è troppo facile? tentare non nuoce!Un vincolo per la sfida è che occorre far verificare al codice se un numero è primo oppure no, quindi sono vietate tabelle di appoggio (recuperare su internet i numeri primi che si trovano nei primi diecimila numeri sarebbe troppo facile). Sono ammesse tutte le funzioni di VBA e tutte le formule di Excel.
Le proposte verranno accettate solo fra cinque giorni da adesso: quindi potrete pubblicare i vostri post da sabato prossimo 16 marzo a partire dalle ore 20. Questa discussione viene chiusa da ora e riaperta al momento giusto.
Eventuali richieste di chiarimento potranno essere fatte in chat o con una mail alla Redazione (i chiarimenti importanti verranno aggiunti a questa discussione).
Il vincitore verrà stabilito mediante sondaggio aperto a tutta la comunità: il sondaggio durerà qualche giorno (verrà stabilito al momento della chiusura della sfida). Solo le risposte che arriveranno in questa discussione verranno prese in considerazione.
In caso di parità si terrà conto del criterio cronologico: vince chi pubblica per primo la sua soluzione, ma tenete conto che soluzioni successive annullano le precedenti! Infatti ognuno può pubblicare tutte le soluzioni che vuole, ma solo l'ultima postata verrà tenuta in considerazione in caso di parità di voti ottenuti.Il vincitore avrà la soddisfazione di aver partecipato e di aver illustrato qualche tecnica magari nuova o interessante. Riceverà anche una piccola coppa accanto al proprio nick! Inoltre avrà l'onore di proporre la sfida successiva!
Quindi pronti? ...via! cominciate a pensarci, ci rivediamo qui a partire da sabato prossimo!
Sfida aperta! Pubblicate! 😀
Ciao,
la mia proposta è basata su
- la UDF bPrimo che restituisce True se il numero in input è un numero primo, altrimenti False.
- la sub GemelliCoppieArr che utilizza un array e che espone su due colonne (A e B) le coppie di numeri primi gemelli.
Function bPrimo(ByVal nVal As Long) As Boolean Dim j As Long Dim vRet As Boolean If nVal < 2 Then vRet = False Else vRet = True For j = 2 To (nVal ^ 0.5) If nVal Mod j = 0 Then vRet = False Exit For End If Next End If bPrimo = vRet End Function Sub GemelliCoppieArr() Dim arrGemelli As Variant, ws As Worksheet Dim k As Long, nLastPrimo As Long, i As Long Dim nLast As Long Set ws = ThisWorkbook.Worksheets("Foglio1") nLast = Int(nMax / Log(nMax) / 4 * IIf(nLast > 1000000, 2, 1)) + 3 ' vedi nota ws.Range("A3:B" & Rows.Count).ClearContents Application.ScreenUpdating = False arrGemelli = ws.Range("A3:B" & nLast).Value nLastPrimo = 2 For k = 3 To nMax If bPrimo(k) Then If k - nLastPrimo = 2 Then i = i + 1 arrGemelli(i, 1) = nLastPrimo arrGemelli(i, 2) = k End If nLastPrimo = k End If Next ws.Range("A3:B" & nLast).Value = arrGemelli Erase arrGemelli Set ws = Nothing Application.ScreenUpdating = True End Sub
La scelta di esporli in coppia mi sembra quella formalmente più corretta; in alternativa la sub GemelliArr li espone su un'unica colonna:
Sub GemelliArr() Dim arrGemelli As Variant, ws As Worksheet Dim k As Long, nLastPrimo As Long, i As Long Dim nLast As Long, nSkip As Byte Set ws = ThisWorkbook.Worksheets("Foglio1") nLast = Int(nMax / Log(nMax) / 2 * IIf(nLast > 1000000, 2, 1)) + 3 ' vedi nota ws.Range("D3:D" & Rows.Count).ClearContents Application.ScreenUpdating = False arrGemelli = Range("D3:D" & nLast).Value nLastPrimo = 2 For k = 3 To nMax If bPrimo(k) Then If k - nLastPrimo = 2 Then i = i + nSkip arrGemelli(i, 1) = nLastPrimo i = i + 1 arrGemelli(i, 1) = k nSkip = 0 Else nSkip = 1 End If nLastPrimo = k End If Next ws.Range("D3:D" & nLast).Value = arrGemelli Erase arrGemelli Set ws = Nothing Application.ScreenUpdating = True End Sub
Ho provato anche una versione utlizzando Dictionary, le prestazioni sono quasi identiche alla versione array:
Sub GemelliDict() Dim dictGemelli As Object 'oppure Scripting.Dictionary se mettiamo il riferimento a Microsoft Scripting Runtime Dim k As Long, nLastPrimo As Long Dim aVals As Variant Range("C3:D" & Rows.Count).ClearContents Application.ScreenUpdating = False Set dictGemelli = CreateObject("Scripting.Dictionary") 'New Dictionary nLastPrimo = 2 For k = 3 To nMax If bPrimo(k) Then If k - nLastPrimo = 2 Then dictGemelli.Add Str(nLastPrimo) & Str(k), Array(nLastPrimo, k) End If nLastPrimo = k End If Next aVals = dictGemelli.Items Range("C3:D" & dictGemelli.Count + 2).Value = Application.Transpose(Application.Transpose(aVals)) Set dictGemelli = Nothing Application.ScreenUpdating = True End Sub
N.B.: attenzione, dichiarare in testa al modulo la costante nMax per impostare il valore superiore dell'intervallo di numeri da elaboratre:
Const nMax As Long = 10000 ' limite superiore intervallo di ricerca dei gemelli, ' variare a piacere
una nota riguardo l'istruzione nLast = Int(nMax / Log(nMax) / 4 * IIf(nLast > 1000000, 2, 1)) + 3
x/log(x) è una buona approssimazione del numero di numeri primi non maggiori di x; i numeri primi gemelli sono meno di 1/2 dei n. primi e quindi le coppie sono meno di 1/4 dei n. primi nell'intervallo in esame (il + 3 è l'offset del range)Abbiamo scatenato scossa 😛
La mia proposta è molto più banale
Public Function is_prime(num As Variant) As Boolean Dim i As Long If (num = 1) Or (num = 2) Or (num = 3) Then is_prime = True Exit Function End If If (num < 1) Or (num <> CLng(num)) Then is_prime = False Exit Function End If For i = 2 To CLng(Sqr(num)) If num Mod i = 0 Then is_prime = False Exit Function End If Next i is_prime = True End Function Sub test_VF() Dim i As Long Dim ri As Long Dim t1 As Single Dim j As Long, t As Long Worksheets("foglio2").Select Range("A:B").ClearContents Cells(1, "A") = 1 Cells(1, "B") = 2 Cells(2, "A") = 2 Cells(2, "B") = 3 ri = 3 For i = 3 To 10000 If is_prime(i) <> False Then If is_prime(i + 2) <> False Then Cells(ri, "A") = i Cells(ri, "B") = i + 2 ri = ri + 1 End If End If Next i MsgBox "Fatto" End Sub
Salve a tutti
le mie proposte (ma per la verità è una sola in quattro varianti) è la seguente
Option Explicit Sub NumeriPrimiGemelli() Dim numeri(1 To 5000) As Integer, gemelli() As Integer Dim i As Long, j As Long, a As Long Dim starting As Single, finished As Single Range("A:B").ClearContents starting = Timer For i = 1 To 10000 If Application.IsOdd(i) Then a = a + 1 numeri(a) = i End If Next i For i = UBound(numeri) To 2 Step -1 For j = i - 1 To 2 Step -1 If numeri(i) / numeri(j) = Int(numeri(i) / numeri(j)) Then numeri(i) = 0 GoTo prox End If Next j prox: Next i 'assegna matrice escludendo lo zero a = 1 For i = 1 To UBound(numeri) If numeri(i) <> 0 Then ReDim Preserve gemelli(1 To a) gemelli(a) = numeri(i) a = a + 1 End If Next i gemelli(1) = 2 a = 0 For i = 2 To UBound(gemelli) - 1 If gemelli(i - 1) + 2 = gemelli(i) Then a = a + 1 Cells(a, 1) = gemelli(i - 1) Cells(a, 2) = gemelli(i) End If Next i finished = Timer Range("M3") = finished - starting End Sub Sub StessaCella_uno() Dim numeri(1 To 5000) As Integer, gemelli() As Integer Dim i As Long, j As Long, a As Long Dim starting As Single, finished As Single Range("D:D").ClearContents starting = Timer For i = 1 To 10000 If Application.IsOdd(i) Then a = a + 1 numeri(a) = i End If Next i For i = UBound(numeri) To 2 Step -1 For j = i - 1 To 2 Step -1 If numeri(i) / numeri(j) = Int(numeri(i) / numeri(j)) Then numeri(i) = 0 GoTo prox End If Next j prox: Next i 'assegna matrice escludendo lo zero a = 1 For i = 1 To UBound(numeri) If numeri(i) <> 0 Then ReDim Preserve gemelli(1 To a) gemelli(a) = numeri(i) a = a + 1 End If Next i gemelli(1) = 2 a = 0 For i = 2 To UBound(gemelli) - 1 If gemelli(i - 1) + 2 = gemelli(i) Then a = a + 1 Cells(a, 4) = gemelli(i - 1) & " - " & gemelli(i) End If Next i finished = Timer Range("M4") = finished - starting End Sub Sub StessaCella_due() Dim numeri(1 To 5000) As Integer, gemelli() As Integer Dim i As Long, j As Long, a As Long, b As Long Dim starting As Single, finished As Single Dim ctr As Boolean a = 1 Range("I:I").ClearContents starting = Timer numeri(1) = 1 numeri(2) = 2 a = 3 'avvio ciclo per creare matrice dal n.3 in poi For i = 3 To 10000 If Application.IsOdd(i) Then 'se è dispari ctr = False For j = a - 1 To 2 Step -1 If i / numeri(j) = Int(i / numeri(j)) And i <> numeri(j) Then ctr = True Exit For End If Next j If ctr = False Then 'non è divisibile per i precedenti If i - numeri(a - 1) = 2 Then b = b + 1 Cells(b, 9) = numeri(a - 1) & " - " & i 'scrive gemelli End If numeri(a) = i 'assegna alla matrice a = a + 1 End If End If Next i finished = Timer Range("M5") = finished - starting End Sub Sub StessaCella_tre() Dim numeri(1 To 5000) As Integer, gemelli() As String Dim i As Long, j As Long, a As Long, b As Long Dim starting As Single, finished As Single Dim ctr As Boolean a = 1 Range("K:K").ClearContents starting = Timer numeri(1) = 1 numeri(2) = 2 a = 3 'avvio ciclo per creare matrice dal n.3 in poi For i = 3 To 10000 If Application.IsOdd(i) Then 'se è dispari ctr = False For j = a - 1 To 2 Step -1 If i / numeri(j) = Int(i / numeri(j)) And i <> numeri(j) Then ctr = True Exit For End If Next j If ctr = False Then 'non è divisibile per i precedenti If i - numeri(a - 1) = 2 Then b = b + 1 ReDim Preserve gemelli(1 To b) gemelli(b) = numeri(a - 1) & " - " & i 'Cells(b, 9) = numeri(a - 1) & " - " & i 'scrive gemelli End If numeri(a) = i 'assegna alla matrice a = a + 1 End If End If Next i For i = 1 To UBound(gemelli) Cells(i, 11) = gemelli(i) Next i finished = Timer Range("M6") = finished - starting 'Stop End Sub
Allego il file
Ciao,
Mario
Allegati:
You must be logged in to view attached files.Grande Marius
Salve
Uno non è un numero primo...
i numeri gemelli non comprendono la serie (1-2) e (2-3)
Questa la macro che utilizzo:
Option Explicit Sub TestCollection() Application.ScreenUpdating = False Dim X As Long, Test As Long, Pos() As Variant, First() As Byte Const ToNumber As Long = 10000 Dim collMarks As New Collection First = ChrW(1) & ChrW(257) & String(ToNumber / 2, ChrW(256)) Test = 3 Do While Test <= ToNumber For X = 2 * Test To ToNumber Step Test First(X) = 0 Next Test = Test + 1 - (Test > 2) Loop With collMarks Test = 0 For X = 1 To ToNumber If First(X) = 1 Then If Test + 2 = X Then .Add X End If Test = X End If Next ReDim Pos(1 To .Count + 1, 1 To 2) For X = 1 To .Count Pos(X, 1) = .item(X) - 2 Pos(X, 2) = .item(X) Next Pos(1, 1) = "< Numeri gemelli >" Pos(1, 2) = "" Cells(1, 1).Resize(.Count, 2).Value = Pos End With ' Application.ScreenUpdating = True End Sub
Grazie della partecipazione Mirko! Io nel mio codice ho lasciato volutamente le coppie (1, 2) e (2, 3) anche se non sono strettamente "numeri primi gemelli", perchè non son separati da un numero (al più sono fratellastri), però tecnicamente 1 è numero primo, infatti soddisfa la condizione di "essere divisibile per se stesso e per uno" 😛
In ogni caso, poichè non c'è in palio un supercomputer quantistico offerto da Admin, accetteremo sia le soluzioni con, che le soluzioni senza, i primi tre numeri 🙂
Velocissima la soluzione proposta da Mirko!!
Non ho ancora messo insieme le soluzioni per provare i tempi però sono curioso anche io! 🙂
Sull'ammissibilità di 1 a numero primo.... mi hanno già cazzuolato in privato quindi ok, mi arrendo
Sol.1: PRIMI GEMELLI CON MATRICE
'faccio partire la matrice da 1 Option Base 1 Option Explicit Sub numeripimiconmatrice() Dim numero As Double Dim i As Double Dim a As Double Dim primo As Boolean Dim row As Integer, lastrow As Integer Dim lista As Range Dim cl As Variant Dim meno As Integer Dim Matrice() As Double Dim j As Long, d As Long, totale As Long j = 1 row = 2 numero = 10000 'InputBox("inserire un numero") ActiveSheet.usedrange.Clear For i = 2 To numero primo = True 'Quindi, per verificare se un numero è primo è 'sufficiente provare a dividerlo per tutti gli interi 'minori di esso For a = 2 To i - 1 If (i Mod a = 0) Then primo = False End If Next If (primo = True) Then ReDim Preserve Matrice(j) Matrice(j) = i j = j + 1 End If Next a = 2 lastrow = Cells(Rows.Count, 1).End(xlUp).row Set lista = Range("a2:a" & lastrow) For d = LBound(Matrice) To UBound(Matrice) - 1 meno = Matrice(d + 1) - Matrice(d) If meno = 2 Then Cells(a, 2) = "[" & Matrice(d) & " ; " & Matrice(d + 1) & "]" a = a + 1 Else End If Next With Range("a1:b1").Font With Range("a1:b1").Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent5 .TintAndShade = -0.249946592608417 .PatternTintAndShade = 0 End With .Name = "Calibri" .FontStyle = "Corsivo grassetto" .Size = 20 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ThemeColor = xlThemeColorAccent2 .TintAndShade = 0.399975585 .ThemeFont = xlThemeFontMinor End With totale = UBound(Matrice) Cells(1, 1).Value = "I Numeri Primi da 2 a 10000 sono " & totale lastrow = Cells(Rows.Count, 2).End(xlUp).row - 1 Cells(1, 2).Value = "Primi Gemelli sono " & lastrow Columns("A:B").EntireColumn.AutoFit Columns("A:B").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom End With Range("a1").Select End Sub
Sol2: PRIMI GEMELLI CON COLONNA
Option Explicit Sub numeripimidefinitivo() 'con appoggio su colonna dei numeri primi Dim numero As Double Dim i As Double Dim a As Double Dim primo As Boolean Dim row As Integer, lastrow As Integer, lastrow1 As Long Dim lista As Range Dim cl As Variant Dim meno As Integer row = 2 numero = 10000 'InputBox("inserire un numero") ActiveSheet.usedrange.Clear For i = 2 To numero primo = True 'Quindi, per verificare se un numero è primo è 'sufficiente provare a dividerlo per tutti gli interi 'minori di esso For a = 2 To i - 1 If (i Mod a = 0) Then primo = False End If Next If (primo = True) Then 'MsgBox (i) Cells(row, 1) = i row = row + 1 End If Next a = 2 lastrow = Cells(Rows.Count, 1).End(xlUp).row Set lista = Range("a2:a" & lastrow) For Each cl In lista meno = cl.Offset(1, 0) - cl If meno = 2 Then 'MsgBox "trovato" Cells(a, 2) = "[" & cl & " ; " & cl.Offset(1, 0) & "]" a = a + 1 Else End If Next lastrow1 = Cells(Rows.Count, 1).End(xlUp).row - 1 With Range("a1:b1").Font With Range("a1:b1").Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent5 .TintAndShade = -0.249946592608417 .PatternTintAndShade = 0 End With .Name = "Calibri" .FontStyle = "Corsivo grassetto" .Size = 20 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ThemeColor = xlThemeColorAccent2 .TintAndShade = 0.399975585 .ThemeFont = xlThemeFontMinor End With Cells(1, 1).Value = "I Numeri Primi da 2 a 10000 sono " & lastrow1 lastrow = Cells(Rows.Count, 2).End(xlUp).row - 1 Cells(1, 2).Value = "Primi Gemelli sono " & lastrow Columns("A:B").EntireColumn.AutoFit Columns("A:B").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom End With Range("a1").Select End Sub
Nota a margine:"tutti i numeri naturali sono divibili per l'unita e per se stessi...quindi non sono numeri primi
[Edit by ADMIN -- riuscito ad inserire il codice sostituendo le parentesi tonde con quadre alla riga Cells(a, 2) =... ]
Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )Allegati:
You must be logged in to view attached files.Adesso mi sembra allegato regolarmente, però non saprei risolvere il messaggio di errore... forse Admin ha una risposta 🙂
E mi piace la tua deduzione logica (anche se intendevi dire che tutti i numeri SONO numeri primi) 😀
Niente da fare, nemmeno togliendo la prima riga di codice commentata.
ho provato ad inserire un codice diverso, nella sezione "area51" e non ho avuto alcun problema.
Il codice incriminato sicuramnete è quello che ho postato con il file, pero non riesco a capire il perchè
A questo punto,non potendo inserire il codice non posso partecipare alla sfida
Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )Ciao a tutti appena accedo al mio computer vi invio anche le mi proposte.
Ciao innanzitutto io ho considerato i numeri da 2 a 10000 pertanto l'1 l'ho escluso
Prima soluzione la più compatta senza function.
Sub NumPrimiGemelliRidDir() Dim NumPrimo(2 To 10000) As Boolean Dim Indice01 Dim Indice02 NumPrimo(2) = True For Indice01 = 3 To 10000 Step 2 NumPrimo(Indice01) = True Next Indice01 For Indice01 = 3 To (10000 - 1) Step 2 If NumPrimo(Indice01) Then For Indice02 = Indice01 + 2 To 10000 Step 2 If ((Indice02 Mod Indice01) = 0) Then NumPrimo(Indice02) = False End If Next Indice02 End If Next For Indice01 = 5 To 10000 Step 2 If NumPrimo(Indice01) And NumPrimo(Indice01 - 2) Then With Range("O" & Rows.Count).End(xlUp) .Offset(1, 0) = Indice01 - 2 .Offset(1, 1) = Indice01 End With End If Next MsgBox "Finito" End Sub
Quella sotto riportata invece è più compatta ma con una function.
Function NumPrimo2(Numero As Long) As Boolean Dim index NumPrimo2 = True For index = 2 To Int(Sqr(Numero) + 1) If ((Numero / index) = (Numero \ index)) Then NumPrimo2 = False Exit For End If Next index End Function Sub NumeriPrimiTwin2() Dim Indice As Long Dim PrimiGemelli() ReDim PrimiGemelli(2, 0 To 0) For Indice = 4 To 10000 If NumPrimo2(Indice) Then If NumPrimo2(Indice - 2) Then ReDim Preserve PrimiGemelli(2, 0 To UBound(PrimiGemelli, 2) + 1) PrimiGemelli(1, UBound(PrimiGemelli, 2)) = Indice - 2 PrimiGemelli(2, UBound(PrimiGemelli, 2)) = Indice End If End If Next For Indice = 1 To UBound(PrimiGemelli, 2) Range("G1").Offset(Indice - 1, 0) = PrimiGemelli(1, Indice) Range("G1").Offset(Indice - 1, 1) = PrimiGemelli(2, Indice) Next End Sub
La function sopra utilizzata può essere sostituita da:
Function NumPrimo(Numero As Long) As Boolean Dim index NumPrimo = True For index = 2 To Int(Sqr(Numero) + 1) If Numero Mod index = 0 Then NumPrimo = False Exit For End If Next index End Function
Ciao
Luca
non posso partecipare alla sfida
Bè hai allegato il file no? certo che puoi partecipare 🙂
vi invio anche le mi proposte.
Ciao Luca e grazie!!
Comunico che la chiusura della sfida avverrà domani sera, lunedì 18 marzo, alle ore 20.
Poi apriremo il televoto 🙂
Bè hai allegato il file no? certo che puoi partecipare
Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )Ciao
HO ottimizzato la mia prima soluzione.
Eccola:
Sub NumPrimiGemelliRidDir_Ott() Dim NumPrimo(2 To 10000) As Boolean Dim Indice01 Dim Indice02 NumPrimo(2) = True For Indice01 = 3 To 10000 Step 2 NumPrimo(Indice01) = True Next Indice01 For Indice01 = 3 To Sqr((10000 - 1) + 1) Step 2 If NumPrimo(Indice01) Then For Indice02 = Indice01 + 2 To 10000 Step 2 If ((Indice02 Mod Indice01) = 0) Then NumPrimo(Indice02) = False End If Next Indice02 End If Next For Indice01 = 5 To 10000 Step 2 If NumPrimo(Indice01) And NumPrimo(Indice01 - 2) Then With Range("O" & Rows.Count).End(xlUp) .Offset(1, 0) = Indice01 - 2 .Offset(1, 1) = Indice01 End With End If Next MsgBox "Finito" End Sub
Ok!
For Indice01 = 3 To Sqr((10000 - 1) + 1) Step 2
In effetti.....bizzarro...
Avevo fatto una modifica "al volo"
Così mi piace di più
Sub NumPrimiGemelliRidDir_Ott() Dim NumPrimo(2 To 10000) As Boolean Dim Indice01 Dim Indice02 NumPrimo(2) = True For Indice01 = 3 To 10000 Step 2 NumPrimo(Indice01) = True Next Indice01 For Indice01 = 3 To (Sqr(10000) + 1) Step 2 If NumPrimo(Indice01) Then For Indice02 = Indice01 + 2 To 10000 Step 2 If ((Indice02 Mod Indice01) = 0) Then NumPrimo(Indice02) = False End If Next Indice02 End If Next For Indice01 = 5 To 10000 Step 2 If NumPrimo(Indice01) And NumPrimo(Indice01 - 2) Then With Range("O" & Rows.Count).End(xlUp) .Offset(1, 0) = Indice01 - 2 .Offset(1, 1) = Indice01 End With End If Next MsgBox "Finito" End Sub
Salve a tutti
Vorrei proporre una variante al sistema di votazione.
E' previsto un solo voto. A mio avviso è insufficiente e non "premia" le diverse sfaccettature della sfida.
Mi piacerebbe poter votare il codice più veloce ma anche quello più geniale ovvero quello che ha centrato in pieno il problema. Mi viene alquanto difficile poter esprimere UN voto ad una persona, che - fra l'altro - può aver presentato più lavori.
Per quanto sopra, il mio plauso è esteso a tutti i partecipanti.
Ciao,
Mario
-
AutoreArticoli