Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1279 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【75285】プロセージャの作成をお願いいたします 本山中 14/2/3(月) 9:34 質問[未読]
【75286】Re:プロセージャの作成をお願いいたします kanabun 14/2/3(月) 14:59 発言[未読]
【75288】Re:プロセージャの作成をお願いいたします 本山中 14/2/3(月) 17:33 質問[未読]
【75289】Re:プロセージャの作成をお願いいたします kanabun 14/2/3(月) 19:01 発言[未読]
【75290】Re:プロセージャの作成をお願いいたします kanabun 14/2/3(月) 19:03 発言[未読]
【75291】Re:プロセージャの作成をお願いいたします kanabun 14/2/3(月) 19:43 発言[未読]
【75293】Re:プロセージャの作成をお願いいたします 本山中 14/2/4(火) 8:40 お礼[未読]
【75285】プロセージャの作成をお願いいたします
質問  本山中  - 14/2/3(月) 9:34 -
引用なし
パスワード
   次の作業が行えるプロセージャを教えてください。
1.10時に、A1〜D10にデータを入力します。
2.12時に、A11〜D15にデータを入力します。
3.B列には4桁の数値が入力されています。
このとき、B列の数値を利用して、12時に入力したデータのうち
10時に入力した数値と同じものがあれば、12時のデータの行を削除し、
空行を生じさせないよう、上へ詰める。
尚且つ、B列の数値を利用して常に昇順にデータを並び変えておく。
データの数が相当あるため、手動処理では時間がかかりすぎます。
宜しくお願いいたします。
【75286】Re:プロセージャの作成をお願いいたします
発言  kanabun  - 14/2/3(月) 14:59 -
引用なし
パスワード
   ▼本山中 さん：

>3.B列には4桁の数値が入力されています。
>このとき、B列の数値を利用して、12時に入力したデータのうち
>10時に入力した数値と同じものがあれば、12時のデータの行を削除し、
>空行を生じさせないよう、上へ詰める。
>尚且つ、B列の数値を利用して常に昇順にデータを並び変えておく。

マクロ内容としては、
１．B列にフィルタオプションをかけて重複カットし、
２．その状態での表をE列以降にコピーしてから、
３．元のA〜D列を削除
４．新しい A〜D列にたいして B列をキーにSortをかける

　　With Range("A1").CurrentRegion
　　　　.Columns("B").AdvancedFilter xlFilterInPlace, Unique:=True
　　　　.Copy Range("E1")
　　　　.Worksheet.ShowAllData
　　　　.EntireColumn.Delete
　　End With
　　With Range("A1").CurrentRegion
　　　　.Sort Key1:=.Columns("B"), Header:=xlYes
　　End With

のような感じでよろしいかと思います。

決めなければいけないのは、
このマクロをどういうタイミングでマクロを実行するか、ですが。
たとえば、B列をダブルクリックしたら、マクロを実行する、とか？
【75288】Re:プロセージャの作成をお願いいたします
質問  本山中  - 14/2/3(月) 17:33 -
引用なし
パスワード
   ▼kanabun さん：
回答、感謝いたします。
実行してみたのですが、最初の行(A1,B1,C1,D1の行)だけが
ダブって残ります。後はうまくいきます。
10時のデータ　A1,B1,C1,D1　の次の行に
12時のデータが　A2,B2,C2,D2　として来てしまう状況です。
>▼本山中 さん：
>
>>3.B列には4桁の数値が入力されています。
>>このとき、B列の数値を利用して、12時に入力したデータのうち
>>10時に入力した数値と同じものがあれば、12時のデータの行を削除し、
>>空行を生じさせないよう、上へ詰める。
>>尚且つ、B列の数値を利用して常に昇順にデータを並び変えておく。
>
>マクロ内容としては、
>１．B列にフィルタオプションをかけて重複カットし、
>２．その状態での表をE列以降にコピーしてから、
>３．元のA〜D列を削除
>４．新しい A〜D列にたいして B列をキーにSortをかける
>
>　　With Range("A1").CurrentRegion
>　　　　.Columns("B").AdvancedFilter xlFilterInPlace, Unique:=True
>　　　　.Copy Range("E1")
>　　　　.Worksheet.ShowAllData
>　　　　.EntireColumn.Delete
>　　End With
>　　With Range("A1").CurrentRegion
>　　　　.Sort Key1:=.Columns("B"), Header:=xlYes
>　　End With
>
>のような感じでよろしいかと思います。
>
>決めなければいけないのは、
>このマクロをどういうタイミングでマクロを実行するか、ですが。
>たとえば、B列をダブルクリックしたら、マクロを実行する、とか？
【75289】Re:プロセージャの作成をお願いいたします
発言  kanabun  - 14/2/3(月) 19:01 -
引用なし
パスワード
   ▼本山中 さん：

>実行してみたのですが、最初の行(A1,B1,C1,D1の行)だけが
>ダブって残ります。後はうまくいきます。

フィルタをかけるとき、一行目は列見出しと仮定されます。だから、
たとえ一行目が実際はデータだったとしても、Excelは頓着しません。
一行目が見出しでないなら、マクロで見出し行を挿入してやりましょう。

それから、上のマクロ、標準モジュールに置いて実行してみたようですが、
B列をダブルクリックすれば、自動で重複カット・マクロが走るように、
改良してみましょう。

シート見出しを右クリックしてそこの「シートの表示」メニューを選択する
と、シートモジュールが現れます。
そこに、以下をコピーしてください。

'-----------------------------------------------------------
Option Explicit

Private Sub Worksheet_BeforeDoubleClick( _
　　　　　　　　ByVal Target As Range, Cancel As Boolean)
　If Target.Column = 2 Then
　　Cancel = True
　　Rows(1).Insert
　　Range("A1:D1").Value = Split("A B C D")
　　With Range("A1").CurrentRegion
　　　　.Columns("B").AdvancedFilter xlFilterInPlace, Unique:=True
　　　　.Copy Range("E1")
　　　　.Worksheet.ShowAllData
　　　　.EntireColumn.Delete
　　End With
　　With Range("A1").CurrentRegion
　　　　.Sort Key1:=.Columns("B"), Header:=xlYes
　　End With
　　Rows(1).Delete
　End If

End Sub
【75290】Re:プロセージャの作成をお願いいたします
発言  kanabun  - 14/2/3(月) 19:03 -
引用なし
パスワード
   言い忘れました。

B列をダブルクリックすると、その
> Private Sub Worksheet_BeforeDoubleClick( _
>　　　　　　　　ByVal Target As Range, Cancel As Boolean)
マクロが走ります。


もうひとつ言い忘れました。
そのマクロは B列に重複がひとつもないときは
ShowAllData の行でエラーになります。
【75291】Re:プロセージャの作成をお願いいたします
発言  kanabun  - 14/2/3(月) 19:43 -
引用なし
パスワード
   ▼本山中 さん：

さらに、別法です。
フィルターオプションを使わないで、重複カットする方法です。
（一行目に見出しを必要としない方法です）
１．まずB列で並び替えます。
２．すると 重複するものが行で連続しますので、B列を下から見ていって
　　ひとつ上の行と同じ値だったら、この行を空白セルにします。
３．そうしたら、B列で空白になっているセルを選択して 選択行を一括削除。

以上です。


以下にコードを示します。
前のコードは
名前を Private Sub Worksheet_BeforeDoubleClickX( _
か何かに変更しておいて、その下に ↓ をコピーしてください。

Private Sub Worksheet_BeforeDoubleClick( _
　　　　　　　　ByVal Target As Range, Cancel As Boolean)
　If Target.Column = 2 Then
　　　Dim i As Long, k As Long
　　　Dim v
　　　
　　　Cancel = True
　　　With Range("A1").CurrentRegion
　　　　　.Sort Key1:=.Columns(2), Header:=xlNo
　　　　　v = .Columns(2).Value
　　　　　For i = UBound(v) To 2 Step -1
　　　　　　　If v(i, 1) = v(i - 1, 1) Then
　　　　　　　　　v(i, 1) = Empty
　　　　　　　　　k = k + 1
　　　　　　　End If
　　　　　Next
　　　　　If k > 0 Then
　　　　　　　.Columns(2).Value = v
　　　　　　　.Columns(2).SpecialCells(xlBlanks). _
　　　　　　　　　　　　　EntireRow.Delete '重複行削除
　　　　　End If
　　　End With
　End If

End Sub

多少こちらのほうが時間はかかるかもしれません
【75293】Re:プロセージャの作成をお願いいたします
お礼  本山中  - 14/2/4(火) 8:40 -
引用なし
パスワード
   ▼kanabun さん：
何度もありがとうございます。
感謝いたします。

>▼本山中 さん：
>
>さらに、別法です。
>フィルターオプションを使わないで、重複カットする方法です。
>（一行目に見出しを必要としない方法です）
>１．まずB列で並び替えます。
>２．すると 重複するものが行で連続しますので、B列を下から見ていって
>　　ひとつ上の行と同じ値だったら、この行を空白セルにします。
>３．そうしたら、B列で空白になっているセルを選択して 選択行を一括削除。
>
>以上です。
>
>
>以下にコードを示します。
>前のコードは
>名前を Private Sub Worksheet_BeforeDoubleClickX( _
>か何かに変更しておいて、その下に ↓ をコピーしてください。
>
>Private Sub Worksheet_BeforeDoubleClick( _
>　　　　　　　　ByVal Target As Range, Cancel As Boolean)
>　If Target.Column = 2 Then
>　　　Dim i As Long, k As Long
>　　　Dim v
>　　　
>　　　Cancel = True
>　　　With Range("A1").CurrentRegion
>　　　　　.Sort Key1:=.Columns(2), Header:=xlNo
>　　　　　v = .Columns(2).Value
>　　　　　For i = UBound(v) To 2 Step -1
>　　　　　　　If v(i, 1) = v(i - 1, 1) Then
>　　　　　　　　　v(i, 1) = Empty
>　　　　　　　　　k = k + 1
>　　　　　　　End If
>　　　　　Next
>　　　　　If k > 0 Then
>　　　　　　　.Columns(2).Value = v
>　　　　　　　.Columns(2).SpecialCells(xlBlanks). _
>　　　　　　　　　　　　　EntireRow.Delete '重複行削除
>　　　　　End If
>　　　End With
>　End If
>
>End Sub
>
>多少こちらのほうが時間はかかるかもしれません
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1279 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free