Как найти четное число в vba

8   голосов , оценка 4.125 из 5

Мне нужно проверять большие объемы чисел и сортировать их по четности. Пока ничего лучшего, кроме деления на 2 и проверки наличия остатка я не предумал. Может есть более быстрый и оптимальный способ проверки числа на четность?

Код на PB:

Код: Выделить всё

#Compile Exe
#Dim All

Function PBMain () As Long
    Dim Ch As Long
    Ch=Val(InputBox$("Input Number"))

    If Frac(Ch/2)>0 Then
        MsgBox "Нечетное"
     Else
        MsgBox "Четное"
    End If

End Function

If число Mod 2 Then Нечётное

If (число / 2)=(число2) Then Чётное

«метод №1 от keks-n’а» скорее всего скомпилируется точно так же.

Компилятор — он умный.

CBool у тебя лишний, кстати.

alibek писал(а):And немного быстрее, чем Mod.

Компилятор про это знает, и поэтому скомпилирует Mod 2 как And 1.

Делфийский точно так делает; с VB не проверял, но вряд ли он глупее.

Код: Выделить всё

Public Function my_mod(ByVal e As Long) As Long

    If e Mod 2 Then

        ass = 123

    End If

End Function

Public Function my_and(ByVal e As Long) As Long

    If e And 1 Then

        assd = 123

    End If

End Function

Код: Выделить всё

110019A0 mod     MOV ECX,DWORD PTR SS:[ESP+4]
110019A4         XOR EAX,EAX
110019A6         AND ECX,80000001
110019AC         JNS SHORT test.110019B3
110019AE         DEC ECX
110019AF         OR ECX,FFFFFFFE
110019B2         INC ECX
110019B3         JE SHORT test.110019BA
110019B5         MOV EAX,7B
110019BA         RETN 4

110019C0 and     MOV CL,BYTE PTR SS:[ESP+4]
110019C4         XOR EAX,EAX
110019C6         TEST CL,1
110019C9         JE SHORT test.110019D0
110019CB         MOV EAX,7B
110019D0         RETN 4

Спасибо за советы, решил проверить все методы на скорость работы, и вычислить среднее время работы каждого способа проверки:

Код на PB 8.03:

Код: Выделить всё

#Compile Exe
#Dim All

Declare Function GetTickCount Lib "KERNEL32.DLL" Alias "GetTickCount" () As Long
Macro maxtest = 100000000

Function PBMain () As Long

Dim Ch As Long
Dim i  As Long
Dim u  As Long
Dim Result As Long
Dim t As Long
Dim Itog As Long
Dim x As Long

'-------------------------------------------------------------------
' Проверка с помощью IF
    t=0
    Result=0
    Itog=0

    For x=1 To 10
     t = GetTickCount - t
     u = GetTickCount
        For i=1 To maxtest
           If Frac(i/2)>0 Then
               Result=1 ' "Нечетное"
            Else
               Result=2 ' "Четное"
            End If
        Next i

       u = GetTickCount - u
       Itog=Itog + u
       t=0
    Next x
'-------------------------------------------------------------------

MsgBox  "Проверка с помощью IF "  & Str$(itog/10) & " мсек. в среднем"

'-------------------------------------------------------------------
' Проверка с помощью AND
    t=0
    Result=0
    Itog=0

    For x=1 To 10
     t = GetTickCount - t
     u = GetTickCount
        For i=1 To maxtest
            If (i And 1) Then
               Result=1 ' "Нечетное"
            Else
               Result=2 ' "Четное"
            End If
        Next i

       u = GetTickCount - u
       Itog=Itog + u
       t=0
    Next x
'-------------------------------------------------------------------

MsgBox  "Проверка с помощью AND "  & Str$(itog/10) & " мсек. в среднем"

'-------------------------------------------------------------------
' Проверка с помощью MOD
    t=0
    Result=0
    Itog=0
    For x=1 To 10
     t = GetTickCount - t
     u = GetTickCount
        For i=1 To maxtest
            If (i Mod 2) Then
               Result=1 ' "Нечетное"
            Else
               Result=2 ' "Четное"
            End If
        Next i

       u = GetTickCount - u
       Itog=Itog + u
       t=0
    Next x
'-------------------------------------------------------------------

MsgBox  "Проверка с помощью MOD "  & Str$(itog/10) & " мсек. в среднем"

End Function         

Код на VB6

Код: Выделить всё

Option Explicit

Declare Function GetTickCount Lib "KERNEL32.DLL" () As Long
Const maxtest = 100000000

Sub Main()

Dim Ch As Long
Dim i  As Long
Dim u  As Long
Dim Result As Long
Dim t As Long
Dim Itog As Long
Dim x As Long
Dim p As Double

'-------------------------------------------------------------------
' Проверка с помощью IF
    t = 0
    Result = 0
    Itog = 0

        For x = 1 To 10
     t = GetTickCount - t
     u = GetTickCount
        For i = 1 To maxtest
           p = (i / 2)
           If p - Int(p) > 0 Then
               Result = 1 ' "Нечетное"
            Else
               Result = 2 ' "Четное"
            End If
        Next i

       u = GetTickCount - u
       Itog = Itog + u
       t = 0
    Next x
'-------------------------------------------------------------------

MsgBox "Проверка с помощью IF " & Str$(Itog / 10) & " мсек. в среднем"

'-------------------------------------------------------------------
' Проверка с помощью AND
    t = 0
    Result = 0
    Itog = 0

        For x = 1 To 10
     t = GetTickCount - t
     u = GetTickCount
        For i = 1 To maxtest
            If (i And 1) Then
               Result = 1 ' "Нечетное"
            Else
               Result = 2 ' "Четное"
            End If
        Next i

       u = GetTickCount - u
       Itog = Itog + u
       t = 0
    Next x
'-------------------------------------------------------------------

MsgBox "Проверка с помощью AND " & Str$(Itog / 10) & " мсек. в среднем"

'-------------------------------------------------------------------
' Проверка с помощью MOD
    t = 0
    Result = 0
    Itog = 0

    For x = 1 To 10
     t = GetTickCount - t
     u = GetTickCount
        For i = 1 To maxtest
            If (i Mod 2) Then
               Result = 1 ' "Нечетное"
            Else
               Result = 2 ' "Четное"
            End If
        Next i

       u = GetTickCount - u
       Itog = Itog + u
       t = 0
    Next x
'-------------------------------------------------------------------

MsgBox "Проверка с помощью MOD " & Str$(Itog / 10) & " мсек. в среднем"

End Sub

Тестовая машина: P4-3 Ггц, двухядерный, с 512 мб ОЗУ

Результаты:

Проверка с помощью IF:

PB — 2553.2 мсек

VB — 5501.1 мсек

Проверка с помощью AND:

PB — 181.2 мсек

VB — 140.6 мсек

Проверка с помощью MOD:

PB — 1487.5 мсек

VB — 139.1 мсек

Если подвести итоги, VB проигрывает по скорости проверки через IF, но выигрывает при использовании AND и MOD

В аттаче исходники и EXE

Хакер писал(а):А вы не видели, что автор спрашивает оптимальнейший и быстрейший способ, коим является способ, предложенный мною, ибо в отличие от всех остальных способов, проделвается одной лишь инструкцией процессора?

Действительно, для PB проверка через AND — самая быстрая. А в VB6 AND и MOD практически одинаковы по скорости

jangle писал(а):Проверка с помощью AND:

PB — 181.2 мсек
VB — 140.6 мсек

Проверка с помощью MOD:

PB — 1487.5 мсек
VB — 139.1 мсек

Как и ожидалось, IEEE-совместимый компилятор PB настолько тупой, что не догадался заменить Mod на And при компиляции.

Может, это стандарт IEEE ему запрещает оптимизировать код?

А то вдруг другие результаты вычислений после оптимизации станут получаться.

Заодно обратите внимание, что в VB критикуемый Хакером «метод №1 от keks-n’а» оказался самым быстрым.