Dimitrisは、列Aに一連の整数値を持っています。彼は、列Bに奇数値、列C​​に偶数値を表示する方法を望んでいます。彼は、値がスペースのない連続したセルにあり、昇順で。ディミトリスは、この方法でデータを処理するためにマクロが必要かどうか疑問に思います。

簡単に言うと、実際、マクロに頼らずにこれを行うことができます。ただし、このタイプの処理を頻繁に実行する必要がある場合は、実際にマクロを使用する方が有益な場合があります。

まず、非マクロアプローチを見てみましょう。必要に応じて、列Aの値が奇数か偶数かを確認する簡単な数式を列BとCに記述し、列に適切な場合は値をコピーすることができます。たとえば、列Bに次のように含めることができます。

=IF(ISODD(A1),A1,"")

列Cで行う必要があるのは、ISODDをISEVENに置き換えることだけです。これらの数式をコピーすると、列Bには奇数の値のみが含まれ、列Cには偶数の値のみが含まれます。もちろん、問題は、結果がDimitrisが探しているものと一致しないことです。彼は、連続するセル（空白なし）の値を必要とし、昇順でそれらを必要とします。

確かに、目的の結果を取得するために追加の手順を実行できます。たとえば、結果を列BとCにコピーし、値を貼り付けて（数式が削除されるように）、結果を並べ替えることができます。これにより、作業に追加の手順が追加されます。

配列数式を使用するだけで、はるかに「クリーンな」結果を得る方法があります。値がセルA1：A100にあると仮定しましょう。セルB1：B100を選択した状態で、数式バーに次のように入力します。

=IFERROR(SMALL(IFERROR(INDEX($A$1:$A$100,SMALL( IF(MOD($A$1:$A$100,2)=1,ROW($A$1:$A$100)),ROW( $A1:$A$100))),""),ROW()),"")

これはすべて単一の式であることを忘れないでください。配列数式として設計されているため、Ctrl + Shift + Enterを入力して終了します。その結果、列Bの連続セルに、昇順で奇数の値が表示されます。偶数の値を列Cに入れるには、最初にB1：B100をC1：C100にコピーします。次に、範囲C1：C100を選択します。 F2を押して編集モードに入り、数式の途中の「= 1」を「= 0」に変更します。

ここでも、Ctrl + Shift + Enterを押して数式を終了します。

A1：A100の範囲に空白がある場合、または範囲にテキスト値がある場合、この式は正しく機能しないことに注意してください。空白が機能しない理由は、それらが公式に0として扱われ、0が偶数と見なされるため、列Cに表示されます。奇数値（列B）を決定する別の公式は、次の配列公式を使用することです。セルB1内：

=IFERROR(SMALL(IF(MOD($A$1:$A$100,2)>0,$A$1:

$A$100,"x"),ROW()),"")

潜在的な「空白セル」の問題に対処するには、セルC1で次の配列数式を使用できます。

=IFERROR(SMALL(IF((MOD($A$1:$A$100,2)=0)*NOT( ISBLANK($A$1:$A$100)),$A$1:$A$100,"x"),ROW()),"")

結果を得るには、B1：C1を必要な数のセルにコピーします。

先ほど、マクロを使用して値を処理する方が有益な場合があることを説明しました。理由は単純です。重複する値を簡単に取り除くことができ（必要な場合）、空白とテキスト値を無視できます。このようなマクロを開発する方法はいくつもあります。処理するセルを選択し、それらのセルの右側にある2つの列をクリアしてから、それらの列にオッズと偶数を配置する必要があるアプローチを選択しました。

Sub OddsEvens()

Dim rSource As Range     Dim c As Range     Dim sTemp As String     Dim iVal As Integer     Dim bGo As Boolean     Dim sCols As String     Dim vMsg As Variant     Dim lOddCol As Long     Dim iOddPtr As Integer     Dim lEvenCol As Long     Dim iEvenPtr As Integer     Dim iOdds(999) As Integer     Dim iEvens(999) As Integer     Dim J As Integer

Set rSource = Selection     If rSource.Columns.Count = 1 Then         lOddCol = rSource.Column + 1         lEvenCol = rSource.Column + 2         sCols = Chr(lOddCol + 64) & ":"

sCols = sCols & Chr(lEvenCol + 64)



sTemp = "The contents of columns " & sCols         sTemp = sTemp & " will be deleted. Ok to proceed?"

vMsg = MsgBox(sTemp, vbYesNo, "Odds and Evens")

If vMsg = vbYes Then             Application.ScreenUpdating = False             Range(sCols).Clear             iOddPtr = 0             iEvenPtr = 0             For Each c In rSource                 bGo = True                 ' Is the cell empty?

If IsEmpty(c.Value) Then bGo = False                 ' Does the cell contain non-numeric value?

If Not IsNumeric(c.Value) Then bGo = False                 If bGo Then                     iVal = c.Value                     If Int(iVal / 2) * 2 = iVal Then                         ' Even number                         ' Check to see if duplicate                         For J = 1 To iEvenPtr                             If iEvens(J) = iVal Then bGo = False                         Next J                         If bGo Then                             iEvenPtr = iEvenPtr + 1                             iEvens(iEvenPtr) = iVal                         End If                     Else                         'Odd number                         ' Check to see if duplicate                         For J = 1 To iOddPtr                             If iOdds(J) = iVal Then bGo = False                         Next J                         If bGo Then                             iOddPtr = iOddPtr + 1                             iOdds(iOddPtr) = iVal                         End If                     End If                 End If             Next c

' Stuff values into proper columns             For J = 1 To iOddPtr                 Cells(rSource.Row + J - 1, lOddCol) = iOdds(J)

Next J             For J = 1 To iEvenPtr                 Cells(rSource.Row + J - 1, lEvenCol) = iEvens(J)

Next J

' Sort values in Odd column             sTemp = Chr(lOddCol + 64) & rSource.Row & ":"

sTemp = sTemp & Chr(lOddCol + 64) & rSource.Row _               + iOddPtr - 1             Range(sTemp).Select             Selection.Sort key1:=Range(Chr(lOddCol + 64) _               & rSource.Row), Order1:=xlAscending

' Sort values in Even column             sTemp = Chr(lEvenCol + 64) & rSource.Row & ":"

sTemp = sTemp & Chr(lEvenCol + 64) & rSource.Row _               + iEvenPtr - 1             Range(sTemp).Select             Selection.Sort key1:=Range(Chr(lEvenCol + 64) _               & rSource.Row), Order1:=xlAscending

rSource.Select             Application.ScreenUpdating = True         End If     End If End Sub

マクロは、選択したセルの値を2つの配列（iEvensとiOdds）のいずれかに詰め込むことによって機能します。これは、マクロが値の重複を簡単にチェックできるようにするために行われます。セルが空でなく、数値が含まれていて、その数値が重複していない場合にのみ、値が適切な配列に追加されます。次に、値が2つの列に戻され、それらの値が並べ替えられます。

_ExcelTips_は、費用効果の高いMicrosoftExcelトレーニングのソースです。

このヒント（6767）は、Microsoft Excel 2007、2010、2013、および2016に適用されます。