| |
手順を変えちゃいましたが、こんな感じでどうでしょうか。
Sub Macro1()
Dim i As Long, j As Long, Tmp As Variant
Dim Min As Long, Max As Long
Dim V As Variant
'----------------------------------------------------------------------------
'テスト用配列生成
ReDim V(1 To 200)
Randomize
For i = LBound(V) To UBound(V)
If i Mod 10 > 0 Then
V(i) = Int(Rnd() * 200) + 1
End If
Next
Range("A1").Resize(UBound(V)).Value = WorksheetFunction.Transpose(V)
'----------------------------------------------------------------------------
'1.並べ替え(挿入ソート)
Min = LBound(V): Max = UBound(V)
If IsEmpty(V(LBound(V))) Then V(LBound(V)) = "E"
For i = Min + 1 To Max
For j = i To Min + 1 Step -1
If IsEmpty(V(j)) Then V(j) = "E"
If Not (V(j - 1) > V(j)) Then Exit For
Tmp = V(j): V(j) = V(j - 1): V(j - 1) = Tmp
Next j
Next i
Range("B1").Resize(UBound(V)).Value = WorksheetFunction.Transpose(V)
'----------------------------------------------------------------------------
'2.重複・差が1の値削除
For i = Max To Min + 1 Step -1
If V(i) <> "E" Then Exit For
Next
For j = i To Min + 1 Step -1
If V(j) - V(j - 1) < 2 Then
V(j) = "E"
End If
Next
Range("C1").Resize(UBound(V)).Value = WorksheetFunction.Transpose(V)
'----------------------------------------------------------------------------
'3.Empty削除
V = Filter(V, "E", False)
Range("D1").Resize(UBound(V)).Value = WorksheetFunction.Transpose(V)
'----------------------------------------------------------------------------
MsgBox "A列：最初の配列" & vbLf & _
"B列：並べ替え後" & vbLf & _
"C列：重複削除後" & vbLf & _
"D列：Empty削除後"
End Sub
|
|
[名前なし]
- 06/9/14(木) 0:55 -
