Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1228to1232
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zahl auswerten

Zahl auswerten
Alifa
Hallo,
wie kann ich mit einem Makro alle fünfstelligen Zahlen (10000-99999) auf Folgendes prüfen. Aus den BENACHBARTEN Ziffern dieser Zahl sollen alle möglichen 1,2,3,4-stelligen Zahlen gebildet werden und geprüft werden, ob sie Primzahlen sind. Beispiel die Zahl 12345. Daraus kann man folgende Zahlen bilden: 1,2,3,4,5,12,23,34,45,123,234,345,1234,2345, 12345. Davon sind 3 Primzahlen. Die MsgBox soll die fünfstellige Zahl anzeigen, welche die meisten Primzahlen bilden kann.
Mein Ansatz:
Alle 15 Möglichkeiten auf "Primzahl" prüfen mit einer IsPrime-Funktion. a1=CInt(left$(a,3) und weiter
If IsPrime(a1) Then...Und ähnlich mit allen 15 Möglichkeiten. Wie die fünfstellige Zahl herausgefiltert werden soll, welche die meisten Primzahlen erlaubt, ermöglicht...?
Gruß Alifa

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Zahl auswerten
18.09.2011 17:36:56
Josef

Hallo Alifa,
und was, wenn bei mehreren Zahlen die selbe Anzahl an Primzahlen vorkommt?

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub primeCheck()
  Dim lngNumber As Long, lngIndex As Long
  Dim lngN As Long, lngM As Long
  Dim lngCount As Long, lngMax As Long
  
  Const lngStart As Long = 10000
  Const lngEnd As Long = 99999
  
  For lngNumber = lngStart To lngEnd
    lngCount = 0
    For lngN = 1 To Len(CStr(lngNumber))
      For lngM = 1 To Len(Mid(CStr(lngNumber), lngN))
        If Clng(Mid(CStr(lngNumber), lngN, lngM)) > 0 Then
          If IsPrime(Clng(Mid(CStr(lngNumber), lngN, lngM))) Then
            lngCount = lngCount + 1
          End If
        End If
      Next
    Next
    If lngCount > lngMax Then
      lngMax = lngCount
      lngIndex = lngNumber
    End If
  Next
  
  MsgBox lngIndex & " - " & lngMax
  
End Sub

Private Function IsPrime(ByVal Number As Long) As Boolean
  Dim lngRoot As Long
  Dim lngIndex As Long
  
  lngRoot = Int(Sqr(Number))
  
  For lngIndex = 2 To lngRoot
    If (Number / lngIndex) = Int(Number / lngIndex) Then
      Exit Function
    End If
  Next
  
  IsPrime = True
End Function



« Gruß Sepp »

Anzeige
AW: Zahl auswerten
18.09.2011 18:06:58
Daniel
Hi
dann ändert man das ganze so ab:

dim strIndex as string
if lngCount = lngMax Then
strIndex = strIndex & "; " & lngNumber
elseIf lngCount > lngMax Then
strIndex = lngNumber
lngMax = lngCount
End If
der Rest bleibt.
Gruß, Daniel
@ Daniel
18.09.2011 18:09:37
Josef

Hallo Daniel,
mir brauchst du das nicht erklären, ich weiß aber nicht, was Alifa vor hat, bzw. wie er mit den ermittelten Zahlen weiterarbeiten will.

« Gruß Sepp »

Anzeige
AW: @ Daniel
18.09.2011 18:26:15
Daniel
Hi
ich habs ja auch nicht dir erklärt, sondern für Alifa hingeschrieben
Da als Ziel ganz klar die Ausgabe in einer Messagebox vorgesehen ist, ist das in dieser Form völlig ok.
auch wenn die "Zahlen" einzeln weiterverarbeitet werden sollen, kann man sie so mit der Split-Funktion leicht wieder auftrennen.
Gruß, Daniel
AW: Zahl auswerten
18.09.2011 18:45:14
Alifa
Hallo Sepp,
habe eigentlich nur den Teil mit der Zählung und dem Maximum nicht selber machen können. Jetzt, wo das Ganze steht, Danke!!
Alifa
AW: Zahl auswerten
18.09.2011 17:40:08
Daniel
Hi
mal ne Frage, wie sieht denn das mit 11111 aus?
da kommt ja jetzt vier mal der Wert 11 vor.
soll das auch viermal als Primzahl gezählt werden oder nur 1x ?
ansonsten, wo ist jetzt dein Problem bei der Aufgabe, zu welchem Teilschritt hast du noch Fragen oder hast du noch garnichts und hoffst, daß dir jemand eine fertige Komplettlösung präsentiert?
gruß, Daniel
Anzeige
AW: Zahl auswerten
18.09.2011 18:27:29
Alifa
Hallo Daniel,
in meinem Beitrag steht, dass die Anzahl der Primzahlen gesucht ist. Natürlich gilt jede nur einmal. Was ich im Stillen gehofft habe ist, dass keiner mir etwas Falsches unterstellt. Was ich nicht raffe, ist der Teil des Makros, der die Primzahlen zählt.
Gruß, Alifa
Teil-Primzahlen ermitteln
18.09.2011 18:40:23
Erich
Hi Erhard,
probier mal

Option Explicit
Sub primeCheck()
Dim lngNumber As Long, ii As Long
Dim lngN As Long, lngM As Long, lngZwi As Long
Dim lngAnz As Long, lngMax As Long
Dim zz As Long, cc As Long, ss As Long, blnWied  As Boolean
Const lngStart As Long = 1
Const lngEnd As Long = 99999
zz = 1
Cells(1, 1).Resize(, 3) = Split("Zahl Anzahl Prim")
For lngNumber = lngStart To lngEnd
lngAnz = 0
For lngN = 1 To Len(CStr(lngNumber))
For lngM = 1 To Len(Mid(CStr(lngNumber), lngN))
lngZwi = CLng(Mid(CStr(lngNumber), lngN, lngM))
If lngZwi > 0 Then
If IsPrime(lngZwi) Then
lngAnz = lngAnz + 1
If blnWied Then
For ss = 3 To cc
If lngZwi = Cells(zz, ss) Then
lngAnz = lngAnz - 1
Exit For
End If
Next ss
If ss > cc Then
cc = cc + 1
Cells(zz, cc) = lngZwi
Cells(zz, 2) = cc - 2
End If
End If
End If
End If
Next lngM
Next lngN
If blnWied Then blnWied = False
If lngAnz > lngMax Then
lngMax = lngAnz:  ii = lngNumber
lngNumber = lngNumber - 1
zz = zz + 1
cc = 2
Cells(zz, 1) = ii
blnWied = True
End If
Next lngNumber
MsgBox ii & " mit " & Cells(zz, 2)
End Sub
Private Function IsPrime(ByVal lngN As Long) As Boolean
Dim ii As Long
If lngN / 2 = Int(lngN / 2) Then Exit Function
For ii = 3 To Int(Sqr(lngN)) Step 2
If lngN / ii = Int(lngN / ii) Then Exit Function
Next
IsPrime = True
End Function
Da kmommt das raus:
 ABCDEFGHIJKLMN
1ZahlAnzahlPrim           
2111           
3112111          
410121101          
51112111          
61135111113133       
710113110111         
81013511011013133       
91131711111313131331     
10137391131371373337373773   
11101136110111113133      
121013171101101313131331     
13103138110310311031333131313    
1431373123313133137113137137337373773

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
Teil-Primzahlen - zurück und neu
18.09.2011 20:35:11
Erich
Hi Erhard,
mein voriger Code war Müll. Bitte vergiss ihn. Ein neuer Versuch:

Sub primeCheck3()
Dim lngNumber As Long
Dim lngN As Long, lngM As Long, lngZwi As Long
Dim lngAnz As Long, lngMax As Long
Dim zz As Long, ss As Long, lngOK(1 To 20) As Long
Const lngStart As Long = 10000
Const lngEnd As Long = 99999
zz = 1
Cells(1, 1).Resize(, 3) = Split("Zahl Anzahl Prim")
For lngNumber = lngStart To lngEnd
lngAnz = 0
For lngN = 1 To Len(CStr(lngNumber))
For lngM = 1 To Len(Mid(CStr(lngNumber), lngN))
lngZwi = CLng(Mid(CStr(lngNumber), lngN, lngM))
If lngZwi > 1 Then
If IsPrime(lngZwi) Then
If lngAnz > 0 Then
For ss = 1 To lngAnz
If lngZwi = lngOK(ss) Then Exit For
Next ss
Else
ss = 1
End If
If ss > lngAnz Then
lngAnz = ss
lngOK(ss) = lngZwi
End If
End If
End If
Next lngM
Next lngN
If lngAnz > 7 And lngAnz >= lngMax Then ' Ausgabe ab 8 Primzahlen
lngMax = lngAnz
zz = zz + 1
Cells(zz, 1) = lngNumber
Cells(zz, 2) = lngMax
For ss = 1 To lngAnz
Cells(zz, ss + 2) = lngOK(ss)
Next ss
End If
Erase lngOK
Next lngNumber
End Sub
Private Function IsPrime(ByVal lngN As Long) As Boolean
Dim ii As Long
If lngN = 2 Then IsPrime = True: Exit Function
If lngN / 2 = Int(lngN / 2) Then Exit Function
For ii = 3 To Int(Sqr(lngN)) Step 2
If lngN / ii = Int(lngN / ii) Then Exit Function
Next
IsPrime = True
End Function
Da kommt raus:
 ABCDEFGHIJKLM
1ZahlAnzahlPrim          
211173811111711173171737733   
311237811112312372233377   
4113118111131131113131331311   
51131710111131131713131331317177 
6113731011113131371373337373773 
713733101313713733373733733773733 
813739101313713733373733739773739 
9137971013137337379379777979797 
1017331101717317337737337331333131 
111973910191971973197399797397737393 
121997310191991997199739979973977733 
1321137102211211311113131373377 
142131710221312131713131331317177 
15213731022137131371373337373773 
162137910221372137913137337379779 
1722397102223223922397232393397977 
1822937102229229322937292939373377 
19231171022323112311733131111177 
202313710223331313313713137377 
2123173102232317333131717173773 
222337110223233233713337337137771 
2323373102232333337337337373773 
242371911223237123719337371977171919
253137311331313313713137137337373773
2631379113313133137313791313737379779
2752379115523523752379223337379779

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Teil-Primzahlen - zurück und neu
19.09.2011 08:05:23
Alifa
Hallo Erich,
zunächst vielen Dank! Wenn man ALLE Primzahlen zählen will, was muss ich an Deinem Makro ändern? Beispiel. Die Zahl 37373. Hier wären es die Primteile: 3,7,3,7,3,37,73,37,73,373,373.
Gruß, Erhard
Teil-Primzahlen - auch Doppelte
19.09.2011 13:27:56
Erich
Hi Erhard,
mit dem Makro

Sub primeCheck4()
Dim lngNumber As Long
Dim lngN As Long, lngM As Long, lngZwi As Long
Dim lngAnz As Long, lngMax As Long
Dim zz As Long, ss As Long, lngOK() As Long
Const lngStart As Long = 10000
Const lngEnd As Long = 99999
zz = 1
Cells(1, 1).Resize(, 3) = Split("Zahl Anzahl Prim")
For lngNumber = lngStart To lngEnd
ReDim lngOK(1 To 20)
lngAnz = 0
For lngN = 1 To Len(CStr(lngNumber))
For lngM = 1 To Len(Mid(CStr(lngNumber), lngN))
lngZwi = CLng(Mid(CStr(lngNumber), lngN, lngM))
If lngZwi > 1 Then
If IsPrime(lngZwi) Then
lngAnz = lngAnz + 1
lngOK(lngAnz) = lngZwi
End If
End If
Next lngM
Next lngN
If lngAnz > 8 And lngAnz >= lngMax Then ' Ausgabe ab 9 Primzahlen
lngMax = lngAnz
zz = zz + 1
Cells(zz, 1) = lngNumber
Cells(zz, 2) = lngMax
ReDim Preserve lngOK(1 To lngAnz)
Cells(zz, 3).Resize(, lngAnz) = lngOK
End If
Next lngNumber
End Sub
kommt das raus:
 ABCDEFGHIJKLMNO
1ZahlAnzahlPrim            
2101379101101313137131373377    
3103119103103133131133131111    
41031311103103110313331313331313133  
51137311111131313713733373737733  
61313711131313313133137131373377  
71373312131371373337373373377373333 
82337312223233333733733373737733 
9313731333131331371313713733373737733
10373371333737337333733777373333373377

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Zahl auswerten
18.09.2011 19:37:45
Daniel
Hi
also unter berücksichtigung folgender Annahmen:
- die Zahlen 0 und 1 sind NICHT PRIM, die kleinste Primzahl ist 2 (definition aus Wikipedia)
- dopppelte Zahlen werden nicht berücksichtigt dh in "10031" wird die 31 nur 1x als Primzahl gezählt, auch für "031" und "0031"
komme ich mit diesem Code:

Sub Makro1()
Dim Zahl As Long, Z As Long
Dim MaxZahl As String, MaxAnz As Long
Dim Zähler As Long
Dim i As Long, x As Long
Dim BereitsGezählt As String
For Zahl = 10000 To 99999
BereitsGezählt = ";"
Zähler = 0
For i = 1 To 5
For x = 1 To 6 - i
Z = CLng(Mid(Zahl, x, i))
If InStr(BereitsGezählt, ";" & Z & ";") = 0 Then
If IsPrime2(Z) Then
Zähler = Zähler + 1
BereitsGezählt = BereitsGezählt & Z & ";"
End If
End If
Next
Next
If Zähler = MaxAnz Then
MaxZahl = MaxZahl & "; " & Zahl
ElseIf Zähler > MaxAnz Then
MaxZahl = Zahl
MaxAnz = Zähler
End If
Next
MsgBox "Die meisten Primzahlen (" & MaxAnz & ") hat: " & vbLf & MaxZahl
End Sub
Function IsPrime(ByVal Number As Long) As Boolean
Dim lngRoot As Long
Dim lngIndex As Long
Select Case Number
Case 0, 1, 4, 6, 8
Exit Function
Case 2, 3, 5, 7
IsPrime = True
Case Else
If Number Mod 2 = 0 Then Exit Function
lngRoot = Int(Sqr(Number))
For lngIndex = 3 To lngRoot Step 2
If (Number / lngIndex) = Int(Number / lngIndex) Then
Exit Function
End If
Next
IsPrime = True
End Select
End Function

zu folgendem Ergebnis:
mit jeweils 11 Primzahlen sind die Werte 23719; 31373; 31379; 52379 führend.
Gruß, Daniel
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige