こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

エクセルのマクロについて

エクセル97のマクロについて教えてください。

下のようなエクセルシートがあると仮定します。
このシート全体を選択して用意してあるボタンを押すと、マクロが流れるようにします。
マクロの中身は、項目1~4の値が同じであれば、同じデータを一つにするというものを考えています。
たとえば下の例の場合、追番でいえば2と4のデータは同じなので、マクロ処理にかけると、追番の大きい4のデータは消え、2のデータの"200"項目にフラグ1が追加されるようにしたいのです。
項目の値が同じであれば、いくつでもデータを統一したいと考えています。

================ エクセル シート例 ==================================

追番_項目1_項目2_項目3_項目4_100_200_300_400 ← 見出し
-----------------------------------------------------------------
1****AAA****BBB****CCC****DDD****1*********1****1****
2****EEE****FFF****CCC****GGG****1**************1****
3****HHH****FFF****KKK****JJJ****1****1****1*********
4****EEE****FFF****CCC****GGG****1****1*********1****

↓ マクロ処理後

追番_項目1_項目2_項目3_項目4_100_200_300_400 ← 見出し
-----------------------------------------------------------------
1****AAA****BBB****CCC****DDD****1*********1****1****
2****EEE****FFF****CCC****GGG****1****1*********1****
3****HHH****FFF****KKK****JJJ****1****1****1*********

===================================================================

注:見出しの_とデータの中の*は空白を生めるためのもので、データとはまったく
関係ありません。

なにぶんエクセルVBAは初心者同然なもので...
よろしくお願い致します。

投稿日時 - 2002-10-21 17:13:01

QNo.386290

暇なときに回答ください

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.2

まずロジックを考える習慣をつけること。
(1)ソート法
A.元データに連番を振る。
B.重複を考えている列でソートする。第2キーはAで振った連番にする。
C.重複を考えている列は上からaaabbccc・・・のようになるから上から直前行と同じか判断し、同じだと行削除し、初出行に重複数カウント数に+1する。
D。必要あれば連番を第1きーでソートして元の順序に戻す。(勿論行抹消しているから歯抜け状態)
(2)テーブル法
A.重複を考えている列で初出のキーを別列に記録して行く。
B.そして上から最終行まで、そのテーブルと比較しテーブルにあれば、その行を削除し、重複件数を+1する。
C.テーブルに無ければ、テーブルにキーを加え、
その行は残し、重複カウント数は1にする。
(3)直接i行のキーに注目しi+1から最終行まで
  同じものがないか調べ、あれば削除し、重複件数を
  +1する(#1のご回答はこれ)
(4)構造を持ちこむ方法
テーブル法は、テーブルにあるキーを総なめで聞きます(それで時間がかかる)がそれを避けるためヒープ(2分木)やBツリーやその他でキーを持つ方法もあります。データ構造に興味が無く、数千行以下であれば、考えることもないかと思いますがあることはあります。ハッシュ法とかも。ABに付いてコードが必要なら載せます。

投稿日時 - 2002-10-21 22:28:25

ANo.1

1行目は表題で、A1から追番、項目1、項目2、項目3、項目4、100、200、300、400 が並んでいるとします。

なぜ"200"項目に書くのかとフラグ1の意味がよく分かりませんが、
一致する行があった場合、"200"項目に一致した回数を書くようにしてみました。
3行が一致していれば、照合回数は1行目と2行目、1行目と3行目の2回で、2を書き込んでいます。
一致した時点で、下にある行のA列には『削除』を書き込んでいるので、2行目と3行目の比較はしないようにしてあります。

シートのコードウインドウに貼り付けます。

Sub DataCheck()
  Dim rg As Range 'セル
  Dim rw1 As Long, rw2 As Long '行カウンタ
  Dim rwMax As Long '最終行
  Dim chk As Integer '同一かどうかチェックする
  Dim SameCot As Long '同一行の数

  rwMax = Range("A1").End(xlDown).Row - 1

  With Range("A1")
    For rw1 = 1 To rwMax - 1
      SameCot = 0
      If .Offset(rw1, 0) <> "削除" Then
        '行単位で比較する
        For rw2 = rw1 + 1 To rwMax
          chk = 0
          If .Offset(rw1, 1) = .Offset(rw2, 1) Then chk = chk + 1
          If .Offset(rw1, 2) = .Offset(rw2, 2) Then chk = chk + 1
          If .Offset(rw1, 3) = .Offset(rw2, 3) Then chk = chk + 1
          If .Offset(rw1, 4) = .Offset(rw2, 4) Then chk = chk + 1
          '全て同じだったら
          If chk = 4 Then
            .Offset(rw2, 0) = "削除" 'A列に『削除』の印を付ける
            SameCot = SameCot + 1
          End If
        Next
      End If
      If SameCot > 0 Then .Offset(rw1, 6) = .Offset(rw1, 6) + SameCot
    Next

    '『削除』マークを付けた行を削除する
    For rw1 = rwMax To 1 Step -1
      If .Offset(rw1, 0) = "削除" Then
        .Offset(rw1, 0).Select: Selection.EntireRow.Delete
      End If
    Next
    .Offset(0, 0).Select
  End With
End Sub

Private Sub CommandButton1_Click()
  DataCheck
End Sub

投稿日時 - 2002-10-21 18:39:32

あなたにオススメの質問