• Najnowsze pytania
  • Bez odpowiedzi
  • Zadaj pytanie
  • Kategorie
  • Tagi
  • Zdobyte punkty
  • Ekipa ninja
  • IRC
  • FAQ
  • Regulamin
  • Książki warte uwagi

visual basic excel Liczby pierwsze

VPS Starter Arubacloud
0 głosów
352 wizyt
pytanie zadane 28 grudnia 2018 w Visual Basic przez error12 Nowicjusz (120 p.)
Witam. Czy ktoś by pomogł? W istniejacych arkuszach danego skoroszytu wyszukać komorki zawierajace liczny pierwsze (przeszzukiwanie wierszami). Znalezione liczby przedstawic rosnaco w pierwszej kolumnie nowo utworzonego arkusza.

1 odpowiedź

0 głosów
odpowiedź 15 lipca 2020 przez Kajman6679 Nowicjusz (180 p.)
edycja 16 lipca 2020 przez Kajman6679

Kod nie przeszukuje wszystkich istniejących arkuszy, tylko wybrany przez nas zakres

 

Sub petla()

Dim rsort As Range
Dim liczba As Integer
Dim i As Integer
Dim sheet As Worksheet

liczba = 0

'Podaj zakres, który się interesuje
On Error Resume Next
Set rsort = Application.InputBox _
("Zaznacz zakres", "Zakres", _
        ActiveCell.Address, , , , , 8)
'dodany warunek żeby  Inputbox się nie sypał, gdy się kliknie Anuluj
If Err.Number <> 0 Then _
Exit Sub
On Error GoTo 0
'dodaj nowy arkusz i nazwij go
Set sheet = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count).Name = "Liczby pierwsze"

'pętla do przetworzenia wszystkich liczb z danego zakresu
For Each cell In rsort
    'dodakowy warunek, bo 2 to też liczba pierwsza
    If cell.Value = 2 Then
        Range("A1").Offset(liczba) = cell.Value
        liczba = liczba + 1
    End If
 'pętla do znalezienia liczb pierwszych
 For i = 2 To cell.Value - 1 Step 1
    If (cell.Value Mod i) = 0 Then
        Exit For
    ElseIf i = cell.Value - 1 Then
        Range("A1").Offset(liczba) = cell.Value
        liczba = liczba + 1
        Exit For
    End If
 Next
Next cell

'sortowanie liczb pierwszych
Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Liczby pierwsze").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Liczby pierwsze").Sort.SortFields.Add2 Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Liczby pierwsze").Sort
        .SetRange Range("A1:A24")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

 

1
komentarz 16 lipca 2020 przez _Pita_ Stary wyjadacz (11,410 p.)
Wstaw jako kod
komentarz 16 lipca 2020 przez Kajman6679 Nowicjusz (180 p.)
Dzięki za komentarz. Jak wstawiałem kod to właśnie coś było nie tak.

Podobne pytania

0 głosów
1 odpowiedź 542 wizyt
pytanie zadane 2 lipca 2019 w Visual Basic przez razor1379 Początkujący (250 p.)
0 głosów
1 odpowiedź 917 wizyt
0 głosów
1 odpowiedź 720 wizyt

92,454 zapytań

141,262 odpowiedzi

319,089 komentarzy

61,854 pasjonatów

Motyw:

Akcja Pajacyk

Pajacyk od wielu lat dożywia dzieci. Pomóż klikając w zielony brzuszek na stronie. Dziękujemy! ♡

Oto polecana książka warta uwagi.
Pełną listę książek znajdziesz tutaj.

Akademia Sekuraka

Akademia Sekuraka 2024 zapewnia dostęp do minimum 15 szkoleń online z bezpieczeństwa IT oraz dostęp także do materiałów z edycji Sekurak Academy z roku 2023!

Przy zakupie możecie skorzystać z kodu: pasja-akademia - użyjcie go w koszyku, a uzyskacie rabat -30% na bilety w wersji "Standard"! Więcej informacji na temat akademii 2024 znajdziecie tutaj. Dziękujemy ekipie Sekuraka za taką fajną zniżkę dla wszystkich Pasjonatów!

Akademia Sekuraka

Niedawno wystartował dodruk tej świetnej, rozchwytywanej książki (około 940 stron). Mamy dla Was kod: pasja (wpiszcie go w koszyku), dzięki któremu otrzymujemy 10% zniżki - dziękujemy zaprzyjaźnionej ekipie Sekuraka za taki bonus dla Pasjonatów! Książka to pierwszy tom z serii o ITsec, który łagodnie wprowadzi w świat bezpieczeństwa IT każdą osobę - warto, polecamy!

...