Excel VBA質問箱 IV

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

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


2947 / 13646 ツリー ←次へ | 前へ→

【65118】整列について ネガメジン 10/4/17(土) 18:11 質問[未読]
【65119】Re:整列について teian 10/4/17(土) 18:35 発言[未読]
【65121】Re:整列について ネガメジン 10/4/17(土) 21:30 質問[未読]
【65122】Re:整列について teian 10/4/17(土) 22:19 発言[未読]
【65123】Re:整列について ネガメジン 10/4/17(土) 22:52 質問[未読]
【65128】Re:整列について teian 10/4/18(日) 11:38 発言[未読]
【65131】Re:整列について ichinose 10/4/18(日) 12:20 発言[未読]
【65136】Re:整列について teian 10/4/18(日) 17:01 発言[未読]
【65130】Re:整列について Hirofumi 10/4/18(日) 12:08 回答[未読]
【65125】Re:整列について ichinose 10/4/18(日) 9:22 発言[未読]
【65137】Re:整列について ネガメジン 10/4/18(日) 17:01 質問[未読]
【65139】Re:整列について teian 10/4/18(日) 17:25 発言[未読]
【65146】Re:整列について ネガメジン 10/4/19(月) 11:17 お礼[未読]
【65145】Re:整列について ネガメジン 10/4/19(月) 11:08 お礼[未読]

【65118】整列について
質問  ネガメジン  - 10/4/17(土) 18:11 -

引用なし
パスワード
   質問します。

  A列
1 5500
2 空セル
3 3000
4 3000
5 空セル
6 空セル
7 6000
8 2000

空セルを上に詰めて整列

 A列
1 5500
2 3000
3 3000
4 6000
5 2000
6
7
8
歯抜けの状態はランダムです。
宜しくお願いします。

【65119】Re:整列について
発言  teian  - 10/4/17(土) 18:35 -

引用なし
パスワード
   Sortを使っては如何でしょうか?
対象の範囲の左に作業用(Sort時のキーに使う)列を用意し、
その列でSortした時に、空白セルが下方に纏まるような状態を作り出します。

以下が例です。
解読してみて下さい。

Sub sample()
  Dim r As Range, c As Range
  Set r = Range("A1:A8")
  r.EntireColumn.Insert xlShiftToRight
  With r.Offset(, -1)
    .Item(1).Value = 1
    .DataSeries
'    For Each c In r
'      If IsEmpty(c) Then c.Offset(, -1).ClearContents
'    Next
    On Error Resume Next
    r.SpecialCells(xlCellTypeBlanks).Offset(, -1).ClearContents
    On Error GoTo 0
    .Resize(, 2).Sort Key1:=.Columns(1), Order1:=xlAscending, _
             Header:=xlNo, Orientation:=xlTopToBottom
    .EntireColumn.Delete xlShiftToLeft
  End With
End Sub

【65121】Re:整列について
質問  ネガメジン  - 10/4/17(土) 21:30 -

引用なし
パスワード
   動作させて見ました。
アドバイスありがとうございます。
不要なデータをクリアして整列させたいと思ってます。
もうひとつ教えていただけますでしょうか。
作業の列を任意に指定するにはどの箇所を修正すればいいのでしょうか。
複数列の表なのでそれ以外で作業出来ればと思います。
お手数をおかけいたします。

【65122】Re:整列について
発言  teian  - 10/4/17(土) 22:19 -

引用なし
パスワード
   ちょっとご質問の主旨がつかめないのですが、
>作業の列を任意に指定するにはどの箇所を修正すればいいのでしょうか。
の質問で、
作業の列と言っているのは、空白を詰めたい列のことですかね。
で、あれば
>  Set r = Range("A1:A8")
を変更すればいいのでは?

じゃなくて、Sort用キーに使う一時的に列挿入した作業用列のことですかね?
私の発想では、任意の余っている列を使うということではなく、
一時的に挿入したとしても最終的にその列を削除してしまい、
元の状態に影響を与えないようにしたものですから、
こちらのことなら、任意の列を指定するような仕様になってませんね〜。

ちょっと質問の意味を掴みかねています。
サンプルコードを提示させて頂きましたが、
もし不明点があるなら、理解不能なところを具体的に指定してもらえると
答えやすいのですが、どの部分が不明ですかね?


>複数列の表なのでそれ以外で作業出来ればと思います。
このあたりも、文面からではどんなデータになっていて、
結果どうしたいのかが分かりません。
前のように、具体例を上げて説明してください。

【65123】Re:整列について
質問  ネガメジン  - 10/4/17(土) 22:52 -

引用なし
パスワード
   ご説明ありがとうございます。
新規シートで動作させて見るとB列で作業しているように見えました。
作業終了後列削除になっているのでしょうか?

  A列    B列   C列  ・・・・G列
1 商品コード 商品名  価格      作業列
2 5000    検索値  検索値
3
4 1000    検索値  検索値
5 4000    検索値  検索値
6
7 2000    検索値  検索値
8
9 4500    検索値  検索値
10

商品コードを入力することで商品名価格を表示してます。
廃番のコードをクリアして整列させたい訳けでが入力順番は
変えたくありません。(ソートすると順番が変わってしまいます)

ご指導の程お願いいたします。

【65125】Re:整列について
発言  ichinose  - 10/4/18(日) 9:22 -

引用なし
パスワード
   おはようございます。
>
>  A列
>1 5500
>2 空セル
>3 3000
>4 3000
>5 空セル
>6 空セル
>7 6000
>8 2000
>
>空セルを上に詰めて整列
>
> A列
>1 5500
>2 3000
>3 3000
>4 6000
>5 2000
>6
>7
>8
>歯抜けの状態はランダムです。
>宜しくお願いします。

この例題できちんと、やりたいことが記述されていますから、
質問者さんの記述が悪いと一概には言えませんね!!

ただ、整列は一般的にソート(並べ替え)と解釈されますからね。

Sub sample1()
  With Range("a2", Cells(Rows.Count, "a").End(xlUp))
    If .Row > 1 Then
     On Error Resume Next
     .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
     On Error GoTo 0
    End If
  End With
End Sub

これでは?

【65128】Re:整列について
発言  teian  - 10/4/18(日) 11:38 -

引用なし
パスワード
   あれあれ、最初の例題とだと条件が違うのですね。
行を削除という行為を取っていいのですか?
1行目はヘッダーのようですね。
それなら、もし、SpecialCellsメソッドで削除行が取得できるくらいの行数なのであれば、
オートフィルターを使って空白行に絞込み、削除するってでのいいかもしれません。
手操作による記録でも取ってみて下さい。
表題から、行削除は行わず、整列させるのみと解釈したのですが、そうじゃないんでしょうか?

で、最初に提示したコード例ですが、
>新規シートで動作させて見るとB列で作業しているように見えました。
とのことですが、
>Set r=Set r = Range("A1:A8")
として、rを特定した上で、
>r.EntireColumn.Insert xlShiftToRight
とA列の左に新しい列を挿入している積もりなんですが、B列で作業しましたか?
そうなっちゃいますかね?
本当にそうなのか、もう一度Step実行して確認してみてくれませんか?
Sortという手法を取っていますが、結果的には、
空白行を下方に集合させるだけで、元の並びは保障したつもりなんですけどね〜。

あと、
>廃番のコードをクリアして整列させたい訳けでが入力順番は
>変えたくありません。(ソートすると順番が変わってしまいます)
廃番のコードとか、例示にない項目をいきなり登場させられても分からんのです。
一応、2度目の提示のあたデータ例をもとに、かってに
A列が空白の行を対象に下方に持っていくというコードにしてみると、

Sub sample2()
  Dim Target As Range
  Dim tmpR As Range
  Dim r As Range, c As Range
  With ActiveSheet
    Set r = .Range("A" & .Rows.Count).End(xlUp) '☆
    Set r = .Range(r.EntireColumn.Cells.Item(1), r)
    Set Target = Intersect(r.EntireRow, .Columns("A:G"))
  End With
  r.EntireColumn.Insert xlShiftToRight
  With r.Offset(, -1)
    .Item(1).Value = 1
    .DataSeries
    For Each c In r
      If IsEmpty(c) Then c.Offset(, -1).ClearContents
    Next
    Union(Target, .Cells).Sort Key1:=.Columns(1), Order1:=xlAscending, _
                  Header:=xlNo, Orientation:=xlTopToBottom
    .EntireColumn.Delete xlShiftToLeft
  End With
End Sub

もし、調査対象が、A列じゃなくB列の空白をってことなら、☆のステップをB列に変更して下さい。


なお、ichinoseさんの以下は、私向けですか?
>質問者さんの記述が悪いと一概には言えませんね!!
私は、別に悪いと言った訳ではありません。
最初の例示は、1列だけだったのでそれを鵜呑みにしたコード例を提示しましたが、
どうも2回目の質問では、複数列の話なんだなってことまでは分かったので、
それなら、同様にちゃんとデータ例を提示してもらいたいと思ったまでです。
なお、
>ただ、整列は一般的にソート(並べ替え)と解釈されますからね。
私がSortで整列させようとしていると思われたのでしょうか?
それについては、もちろん、並び替えないでという条件は最初の提示例で認識してましたよ。

【65130】Re:整列について
回答  Hirofumi  - 10/4/18(日) 12:08 -

引用なし
パスワード
   こんなでは?

Listの先頭見出し位置をrngListで指定
空白を検出する列をclngKeyで指定
(基準位置「rngList」がA列なら、基準位置A列から検出列A列の列Offsetで0
  例えば、基準位置A列で検出列B列なら列Offsetで1
      基準位置B列で検出列B列なら列Offsetで0
      基準位置B列で検出列C列なら列Offsetで1)
Listの列数をclngColumnsで指定
 例えば、ListがA列〜G列なら7列で、8列目(H列)に作業列が設けられ
 削除される行は1が立てられ、されない行は0に成ります
作業列(H列)をKeyとしてListが整列されます
 Excelは安定な整列を行う為、Listの順位は変わりません
 多分、teianさんのコードもListの順位は変わらない筈です

Option Explicit

Public Sub Sample()

  '★データの列数(A列〜G列)
  Const clngColumns As Long = 7
  '★空白の検出列位置を設定 (基準列位置からの列Offsetで指定、A列)
  '基準位置(rngList)がA列なら、A列からA列の列Offsetで0
  Const clngKey As Long = 0
  
  Dim i As Long
  Dim lngRows As Long
  Dim lngCount As Long
  Dim rngList As Range
  Dim vntData As Variant
  Dim lngDelete() As Long
  Dim strProm As String
  
  '★データの左上隅を基準位置とする(列見出し「商品コード」の位置)
  Set rngList = ActiveSheet.Cells(1, "A")
  
  With rngList
    '行数の取得
    lngRows = .Offset(Rows.Count - .Row, clngKey).End(xlUp).Row - .Row
    If lngRows <= 0 Then
      strProm = "データが有りません"
      GoTo Wayout
    End If
    '検出列データを配列に取得
    vntData = .Offset(1, clngKey).Resize(lngRows + 1).Value
  End With

  'Flagを格納する配列を確保
  ReDim lngDelete(1 To lngRows, 1 To 1)

  Application.ScreenUpdating = False

  'データ行数分繰り返し
  For i = 1 To lngRows
    'KeyがEmptyなら
    If Trim(vntData(i, 1)) = Empty Then
      '削除フラグを立てる
      lngDelete(i, 1) = 1
      '削除数をカウント
      lngCount = lngCount + 1
    End If
  Next i
  
  With rngList
    '削除する行が合った場合
    If lngCount > 0 Then
      '削除フラグの配列をデータ列の右側に出力
      .Offset(1, clngColumns).Resize(lngRows).Value = lngDelete
      '削除フラグの列をKeyとして整列
      .Offset(1).Resize(lngRows, clngColumns + 1).Sort _
          Key1:=.Offset(, clngColumns), Order1:=xlAscending, _
          Header:=xlNo, OrderCustom:=1, _
          MatchCase:=False, Orientation:=xlTopToBottom, _
          SortMethod:=xlStroke
      '行の消去(空白行なら不要かも?)
'      .Offset(lngRows - lngCount + 1).Resize(lngCount, clngColumns).ClearContents
      ''削除フラグの列を削除
      .Offset(, clngColumns).EntireColumn.Delete
      strProm = "処理が完了しました"
    Else
      strProm = "空白行が有りません"
    End If
  End With

Wayout:

  Application.ScreenUpdating = True

  Set rngList = Nothing

  MsgBox strProm, vbInformation

End Sub

【65131】Re:整列について
発言  ichinose  - 10/4/18(日) 12:20 -

引用なし
パスワード
   こんにちは。

>なお、ichinoseさんの以下は、私向けですか?
>>質問者さんの記述が悪いと一概には言えませんね!!
違いますよ!!全部質問者さん向けです。
私は、この掲示板に10年ぐらいお世話になっていますが、
結構、質問者の投稿にはうるさいんです。

最低でも 

仕様概要
 入力データの説明(例を引用して)
 出力データの説明(例を引用して)

それから 自分で作成できているVBAコードの提示

を行ってください。

なんていうことをよく記述しています
そういう観点から言えば、ネガメジンさんというHNは初めて見る名前だったので
よく記述されているけれども 整列という言葉が引っかかっていただけです。

申し訳なかったのですが、teianさんお投稿はよくみていませんでした。
ただ、ネガメジンさんの投稿から、並べ替えがされているのかなあ
と想像はしました。これは、申し訳なかったです。

【65136】Re:整列について
発言  teian  - 10/4/18(日) 17:01 -

引用なし
パスワード
   ichinoseさん、了解しました。
お返事ありがとうございました。

あと、蛇足ですが、Hirofumiさんのコメントにもあるように、
> Excelは安定な整列を行う為、Listの順位は変わりません
> 多分、teianさんのコードもListの順位は変わらない筈です
で、Sortのキー列には、ブランクか任意の固定値にしておき、
その列でSortすればおっしゃるように元の順番は保障されます。
私の場合は、用心深いかもしれませんが、DataSeriesメソッドで上から連番を付けておき、
不要な行の場合は、その連番をクリアするという手法をとっています。
その列でSortしますので、当然ながら空白行以外は元の順番を保つようになると思います。

▼ichinose さん:
>こんにちは。
>
>>なお、ichinoseさんの以下は、私向けですか?
>>>質問者さんの記述が悪いと一概には言えませんね!!
>違いますよ!!全部質問者さん向けです。
>私は、この掲示板に10年ぐらいお世話になっていますが、
>結構、質問者の投稿にはうるさいんです。
>
>最低でも 
>
>仕様概要
> 入力データの説明(例を引用して)
> 出力データの説明(例を引用して)
>
>それから 自分で作成できているVBAコードの提示
>
>を行ってください。
>
>なんていうことをよく記述しています
>そういう観点から言えば、ネガメジンさんというHNは初めて見る名前だったので
>よく記述されているけれども 整列という言葉が引っかかっていただけです。
>
>申し訳なかったのですが、teianさんお投稿はよくみていませんでした。
>ただ、ネガメジンさんの投稿から、並べ替えがされているのかなあ
>と想像はしました。これは、申し訳なかったです。

【65137】Re:整列について
質問  ネガメジン  - 10/4/18(日) 17:01 -

引用なし
パスワード
   ありがとうございます。
動作結果は目的通りです。
最小の例題で応用出来ればと思いましたが
内容が高度で難しいです。
最初の質問の内容で列に商品コード(数値)が歯抜け状態で
入力されています。空セルを上に詰めて並べたいのです。
こちらの質問が紛らわしくてすみません。

実際の表の内容を記載します。

  A B C D E   F ・・・・・・M・・・T・・・AA・・・AH
1     
2  タイトル行  商品コード
3           5500
4
5           3000



24          6000
25  タイトル行  商品コード
26          1000

・          4000
47          2500

F3〜F24   F26〜F47
M3〜M24   M26〜M47
T3〜T24   T26〜T47
AA3〜AA24  AA26〜AA47
AH3〜AH24  AH26〜AH47
上記の範囲で並べ替えたいです。
宜しくお願いいたします。

【65139】Re:整列について
発言  teian  - 10/4/18(日) 17:25 -

引用なし
パスワード
   なんと、同時間にレスしたようですね。
で、
全然認識が違ったようですね。
ある特定範囲を各々空白セルを詰めるってことですか?

その特定範囲が固定で、
F3〜F24   F26〜F47
M3〜M24   M26〜M47
T3〜T24   T26〜T47
AA3〜AA24  AA26〜AA47
AH3〜AH24  AH26〜AH47
と限定されているのであれば、

簡単にやるんであれば、
私の最初のコードの"r"という範囲にその固定範囲を各々(For Eachループ)で
設定してやればよさそうですね。

Sub sample10()
  Dim 対象範囲 As Range
  Dim r As Range, c As Range
  With ActiveSheet
    Set 対象範囲 = Intersect(.Range("F:F,M:M,T:T,AA:AA,AH:AH"), .Range("3:24,26:47"))
  End With
  For Each r In 対象範囲.Areas
    Debug.Print r.Address
    r.EntireColumn.Insert xlShiftToRight
    With r.Offset(, -1)
      .Item(1).Value = 1
      .DataSeries
      On Error Resume Next
      r.SpecialCells(xlCellTypeBlanks).Offset(, -1).ClearContents
      On Error GoTo 0
      .Resize(, 2).Sort Key1:=.Columns(1), Order1:=xlAscending, _
               Header:=xlNo, Orientation:=xlTopToBottom
      .EntireColumn.Delete xlShiftToLeft
    End With
  Next
End Sub

【65145】Re:整列について
お礼  ネガメジン  - 10/4/19(月) 11:08 -

引用なし
パスワード
   アドバイス頂いた皆様ありがとうございました。
自分なりに記述を解読してましたが難しいです。
でも作業の流れ的なものは分かりました。
これからも勉強して参ります。

【65146】Re:整列について
お礼  ネガメジン  - 10/4/19(月) 11:17 -

引用なし
パスワード
   teian様

ありがとうございました。
手作業が自動化できて助かります。
はじめてのサイトでしたがご親切に感謝いたします。

2947 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free