SSブログ

EXCEL2000 VBA 選択範囲(1列)の重複を取り除いて右側に表示する。 実験 [Excel2000 VBA独習]

EXCEL2000 VBA  選択範囲(1列)の重複を取り除いて右側に表示する。 実験

ExcelVBA_jyuufuku_01.png

Sub選択範囲列の重複データを取り除いたデータを作る()
'選択範囲の重複データを取り除いたデータを作る
'
Dim ij As Long       '汎用
Dim d() As Variant    'セル値格納用配列
Dim k As Long        '重複の無いデータ個数
Dim x As Variant     '
Dim FL1 As Integer  '重複が有れば FL=1 無ければ FL=0
Dim sRow As Long    '選択範囲の先頭列番号
Dim sCol As Long        '選択範囲の列番号
 
ReDim d(Selection.Rows.Count + 1)
If Selection.Columns.Count > 1 Then MsgBox "列幅は1つにしてください": Exit Sub
sRow = Selection.Row
sCol = Selection.Column
d(1) = Selection.Rows(1)
k = 1
For i = 1 To Selection.Rows.Count
    x = Selection.Rows(i).Value
    FL1 = 0
    '重複があるか判定
        For j = 1 To k
            If d(j) = x Then FL1 = 1     'd()の値と同じもが有ればFL=1
        Next j
        If FL1 <> 1 Then d(k + 1) = xk = k + 1  '重複が無ければ値をd(+1)に代入
             'Debug.Print k, d(k)
        Next i
    'd()一覧を表示
        For i = 1 To k
            Cells(sRow + i - 1, sCol + 1) = d(i)
        Next i
 
End Sub
 

 

 


追記 
 一応 使えるかも?バージョン

 

Sub 選択範囲列の重複データを取り除いたデータを作る()
'選択範囲の重複データを取り除いたデータを作る
'
    Dim ij As Long       '汎用
    Dim d() As Variant    'セル値格納用配列
    Dim k As Long        '重複の無いデータ個数
    Dim x As Variant     '
    Dim FL1 As Integer  '重複が有れば FL=1 無ければ FL=0
    Dim sRow As Long    '選択範囲の先頭列番号
    Dim sCol As Long        '選択範囲の列番号
    Dim input_range As Range    'InputBox で入力されたRange
 
    On Error GoTo Er
 
'配列の個数設定
    ReDim d(Selection.Rows.Count + 1)
'選択列数 確認
    If Selection.Columns.Count > 1 Then MsgBox "列幅は1つにしてください": Exit Sub
'初期設定
    sRow = Selection.Row    '選択セルの先頭行番号
    sCol = Selection.Column '選択セルの列番号
    d(1) = Selection.Rows(1)    '先頭セルの値を配列(1)に代入
    k = 1                           '重複しないデータの個数初期値
'行数分だけ処理
    For i = 1 To Selection.Rows.Count
        x = Selection.Rows(i).Value
        FL1 = 0
         '重複があるか判定
            For j = 1 To k
                If d(j) = x Then FL1 = 1     'd()の値と同じもが有ればFL=1
            Next j
                If FL1 <> 1 Then d(k + 1) = xk = k + 1  '重複が無ければ値をd(+1)に代入
             'Debug.Print k, d(k)
    Next i
    'd()一覧を表示するセルを決める
        'inputobox で入力
inB:    'ラベル
    'Inputboxでセル選択
            Set input_range = Application.InputBox("表示する先頭セルを1つ選択してください。", _
            "表示セルの選択", , , , , , 8)
 
    'd()一覧を表示
        For i = 1 To k
            input_range.Offset(i - 1, 0) = d(i)
        Next i
    '終了
    Exit Sub
Er:  'エラー処理
    'キャンセルボタンが押されたら のつもり
        If Err.Number = 424 Then Exit Sub
    '選択セルが1つ以上
        If Err.Number = 13 Then MsgBox "選択セルは1つにしてください": GoTo inB
    'その他のエラー
    MsgBox "error " & Err.Number
 
End Sub

 

 

 


nice!(0)  コメント(0)  トラックバック(0) 
共通テーマ:パソコン・インターネット

nice! 0

コメント 0

コメントを書く

お名前:
URL:
コメント:
画像認証:
下の画像に表示されている文字を入力してください。

トラックバック 0

この広告は前回の更新から一定期間経過したブログに表示されています。更新すると自動で解除されます。