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

解決済みの質問

[VBA]指定の範囲内で繰り返す

こちらの識者の方々にはいつもお世話になっています。
VBAの質問です。

環境は下記になります。
OS=windows7 pro 64bit
Office=Excel2010(14.0.7128.5000)

・やりたいこと
題名に大いに不足があり申し訳ないです(文字制限の中で適切に表現できませんでした)。
添付ファイルのようなリストがあり、マクロを実行するたびに"CRT","CRN","MRT","MRN"を一つ↓にずらしてループさせたいのですが、
"CRT","CRN"についてはB列の値0の範囲内で、"MRT","MRN"についてはB列の値1の範囲内でそれを行いたいのです。
つまり、"CRN"が16行目にあるときに実行したら、"CRN"を2行目に持ってくる("CRT"も同様)、
"MRN"が31行目にあるときに実行したら"MRN"を17行目に持ってくる、という感じです。

Cat0,1ともに15個ですので下段の通り現在はMOD関数でカウンター変数の余りを求めて処理していますが、
あまりいい処理とは思えません。
(Cat0,1共に同一数でなければならないという制約が付くので)

Option Explicit
Option Base 1

Sub hoge2()
 Dim Wb As Workbook, Ws As Worksheet
 Dim i As Long, iNA As Long, EndRow As Long
 Dim mtxNI As Variant, mtxNA As Variant
 
 Set Wb = ThisWorkbook
 Set Ws = Wb.Sheets(3)
 EndRow = Ws.Cells(Rows.Count, 1).End(xlUp).Row
 mtxNI = Ws.Range("A1:J" & EndRow).Value
 
 mtxNA = Array("CRT", "CRN", "MRT", "MRN")
 For iNA = 1 To UBound(mtxNA)
  For i = 2 To EndRow
   If mtxNI(i, 10) = mtxNA(iNA) Then
    mtxNI(i, 10) = ""
    If i Mod 15 = 1 Then
     mtxNI(i - 14, 10) = mtxNA(iNA)
    Else
     mtxNI(i + 1, 10) = mtxNA(iNA)
     Exit For
    End If
   End If
  Next i
 Next iNA
 Ws.Range("A1:AO" & EndRow).Value = mtxNI
 
End Sub

この場合どのようなコードが適していますでしょうか。
まだまったく理解できていませんが、クラスモジュールのほうが適しているのでしょうか?

質問に不備不足等ございましたらご指摘ください。
ご面倒お掛けしますがよろしくお願いします。

投稿日時 - 2015-12-11 10:54:31

QNo.9093999

困ってます

質問者が選んだベストアンサー

こんにちは。お邪魔します。

> もっと平易というか、保守性が高く、無駄のない、可読性に優れたコードが無いものかと ...
人様への返信を引用するのは恐縮なのですが、
そうありたいとは恒に思いつつも中々その通りには出来ない、
という、、、高い理想、である訳で、気後れしそうですが、
私なりに努めて答えを書いてみます。
ただ、「保守性」ということになると「メンテのし易さ」まで慮って、
「無駄のなさ」「可読性」という点でギャップを大きく感じる方も
居られるでしょうから、多分に管理者の個性に頼る面もあり、
相対的になるのはある程度避けられないだろうとは思います。
私なりに書くと、少し保守寄り(?そんなキャラではありませんが自分の職場の基準寄り)
になってしまうのかな?と。
なので、解(ほぐ)したいところは適当に手直しを入れて貰えればな、と思いつつ書きました。

> "CRT","CRN"についてはB列の値0の範囲内で、"MRT","MRN"についてはB列の値1の範囲内で
このての対応関係を表す、定義(テーブル/辞書)、については、
Excelでは本来、シート上に表現しておく方が保守的ですし設計が簡易になります。
(余談。一昔前ならCustomDocumentProperties、今ならCustomXMLPartsを使う方法もあるようですが、
 それこそ、マクロを読むだけでは気が付かないものになってしまいます)
  "CRT" 0
  "CRN" 0
  "MRT" 1
  "MRN" 1
という対応関係を解り易くする、というのは、「可読性」に直結するのではないでしょうか。
今回は、Array()関数をネストして上記の表のような要素配列で、
二次元配列を明示的に表現するようにしました。
Excel関数に強い人なら、Evaluateメソッド(またはショートカット)で、
二次元配列を表現する方が簡素な印象はあるでしょうけれど、
誰にでも解るかどうかという点で「可読性」にArray()関数を使っています。
より複雑な処理をする場合なんかは、
CollectionオブジェクトやDictionaryオブジェクトを用いたりすることもあるでしょう。
Classモジュールについては、定義(リスト/辞書)が固定で、コード上で変更するだけなら、
必要はないですね。Typeで宣言したい、という方も居るのかも知れませんが、
却って「可読性」というか、理解され難いものになるのだと思います。

> Cat0,1ともに15個ですので下段の通り現在はMOD関数でカウンター変数の余りを求めて処理していますが、
> あまりいい処理とは思えません。
> つまり、"CRN"が16行目にあるときに実行したら、"CRN"を2行目に持ってくる("CRT"も同様)、
> MRNが31行目にあるときに実行したら"MRN"を17行目に持ってくる、という感じです。
ここら辺を読む限りでは、
 (Visual Basic とは別の系譜に離れて5年)
 Visual Basic for Applications ユーザーとして、
 そしてExcelカテゴリへの質問であることも合わせて考えると、
お奨めするのは、.Find メソッドを軸に設計することです。
Excel の一般機能[検索]を再現する.Find メソッドでは、
「この次に見つかる」という指示だけで、最下行の次に最上行を追ってくれますから、
ループで(意図を汲み難い)工夫をする必要がない、という一点だけで、
大きく簡素化できます。
また、万が一検索結果がNothingになっていても、
エラートラップよりも簡単なやり方(Nothing判定)で、
エラー回避できる点でも、保守的に読み易く書くことに繋がります。

ご質問について、
もしも、二次元配列変数の演習という意図が含まれているのでしたら、
あらためて補足してみて下さい。
ただ、
セルの値と配列変数のやりとりにループを挟むような方法を
今回の課題については、私なら、選びません(適した場面なら寧ろ積極的な私ですが、、、)。

因みに、ですが、
修飾子mtx-は(段階配列ではない)一次元配列の場合にはあまり使われないかも、です。
Variant型、または、Variant型配列、で宣言する変数の修飾子に、
mtx-を使うのは、私を含めて小数派です。
元々は、アメリカやドイツのサイトで見かけたもので、
一次元なら、ary-やarr-、二次元または段階配列なら、mtx-、
という区別をはっきりさせる意図で使われていたものだと思います。
配列変数を多用する私が拘って、一次元か二次元かを修飾子に表しているだけで、
どちらもary-で表現するのが多数派のようですので、
(もっと言えば、配列であることすら表現しない書き手も普通に多いですし)
一応念の為。
ついでに、Option Base 1 についてですが、
複数セル範囲の値(.Value等)をVariant型に格納する場合は、
放っておいても最小の添え字は 1 になります。
また、Array()関数の場合は、Option Baseに依存、
VBA.Array()関数は、常に 0 オリジンです。
個人的には、Option Base 1 が原因で、
転用されたり、改編された時に、設計意図を汲んで貰えない、という経験が何度か
あったので、Option Base を使わず、Option Base に左右されないように書く、
というのが、最近の私の「保守」に対する考え方になりました。
やや蛇足かも、でしたね。

以下、動作確認はしましたが、ニーズに即わない場合はご指摘ください。
シートがどのような状況であっても、
とにかく次を探す、または、見つからなければ(Else以下に追記すれば別ですが)何もしません。

' ' ///
Sub ReW9093999c()
Dim Wb As Workbook, Ws As Worksheet
Dim rngMarkPos As Range, rngNewPos As Range
Dim mtxMkCat As Variant
Dim nColDiff As Long, EndRow As Long, iNA As Long

' ' 動作条件変更時の指定修正項目
Const CAT_COL = "B", MARK_COL = "I"
  Set Wb = ThisWorkbook
  Set Ws = Wb.Sheets("Sheet1") ' シートの並び順(Index)での指定は避けたい(保守)
  nColDiff = Ws.Columns(MARK_COL).Column - Ws.Columns(CAT_COL).Column
  mtxMkCat = VBA.Array( _
          VBA.Array("CRT", 0), _
          VBA.Array("CRN", 0), _
          VBA.Array("MRT", 1), _
          VBA.Array("MRN", 1) _
          )

' ' 以下、修正不可。
  EndRow = Ws.Cells(Rows.Count, 1).End(xlUp).Row
  With Ws.Columns(MARK_COL)
    For iNA = LBound(mtxMkCat) To UBound(mtxMkCat)
      Set rngMarkPos = .Find( _
        What:=mtxMkCat(iNA)(0), After:=.Cells(1), LookIn:=xlValues, LookAt:=xlWhole, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext)
      If Not rngMarkPos Is Nothing Then
        Set rngNewPos = .Offset(0, -nColDiff).Find( _
          What:=mtxMkCat(iNA)(1), After:=rngMarkPos.Offset(0, -nColDiff))
      ' Else ' 見つからないなら、、、msg ?
      End If
      If Not rngNewPos Is Nothing Then
        rngMarkPos.ClearContents ' 元々のマークした値を消すのはココ!
        rngNewPos.Offset(0, nColDiff) = mtxMkCat(iNA)(0) ' 新たにマーク値を設定する
        Set rngMarkPos = Nothing:  Set rngNewPos = Nothing
      ' Else ' 見つからないなら、、、msg ?
      End If
    Next iNA
  End With
End Sub
' ' ///

投稿日時 - 2015-12-11 22:53:09

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

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

回答(6)

ANo.6

No.5、書き忘れ、追記です。

変数 Wb Ws EndRow については、
ご質問文で説明されている以外に他の処理があって、そちらで使うのかも知れない、
という意味で、ご提示の宣言と設定を踏襲していますが、
私が提示した処理内容だけであるのなら、
わざわざ変数にしなくても済むものですし、無い方が明らかに読み易いものになります。
特に EndRow は値を設定するだけで他で使われていませんから、
このままあるなら、むしろ読む方にとっては混乱の元になってしまいます。
ここで説明している理由(踏襲)以外に、これらの変数を扱う理由はありませんので、
必要かどうかの判断はお任せします。
以上です。お邪魔しました。

投稿日時 - 2015-12-11 23:59:58

ANo.4

>"CRT","CRN"についてはB列の値0の範囲内で、"MRT","MRN"についてはB列の値1の範囲内でそれを行いたい

不明1)
CRT,CRNが最初からゼロの行に「ある」、MRT、MRNが1の範囲にある事が前提となっているが、それは運用によって確実に保証されているのか。
もし何らかの理由でたとえばCRTが1の行にあったら、どう処理したいのか。(そういうケースは考えなくて良いのか)

不明2)
CRT,CRNをゼロの行の範囲内でぐるぐる廻したいワケだが、そもそもゼロの行は「1カタマリ」にまとまっていることが運用によって確実に保証されているのか。ゼロの行範囲が飛び飛びに2つ3つカタマリと散らばっている状況は全く想定しなくて良いのか。
1についても同じ。


sub macro1()
 dim ax as variant
 dim r as long
 dim buf as variant
 dim TargetRow as long

 for each ax in array("CRT","CRN","MRT","MRN")
 ’CRT他がJ列に「無い」ケースは想定しない
  r = application.match(ax, range("J:J"), 0) ’今ある行
  select case ax
   case "CRT", "CRN"
    buf = 0
   case "MRT", "MRN"
    buf = 1
  end select

’次に持ってく先の行を探す
  targetrow = range("B:B").find(what:=buf, lookin:=xlvalues, lookat:=xlwhole, searchdirection:=xlnext, after:=cells(r, "B")).row
  cells(r, "J").clearcontents
  cells(targetrow, "J") = ax
 next
end sub

投稿日時 - 2015-12-11 22:30:01

お礼

言葉足らずで申し訳ありませんでした。
不明1,2共に、懸念の点については完璧に担保されております。

そしてFindメソッドの有用な使い方を教えていただきありがとうございます。
引数Afterで現在のセル番地を指定して、SearchDirectionをxlNextにすれば、After以降データがない場合は指定範囲内で最初のWhatの位置を検索するということなんでしょうか。
シンプルでとても分かりやすいコードです。
ご回答ありがとうございました。
とても参考になりました。

投稿日時 - 2015-12-14 12:27:24

ANo.3

極めて鈍くさいですが、見た目的には、分かりやすいプログラムだと思うのですが・・・

Option Explicit

Sub Test_01()
Dim c, m, crt, crn, mrt, mrn As Integer
c = Range("B:B").Find(0, SearchDirection:=xlPrevious).Row
m = Range("B:B").Find(1, SearchDirection:=xlPrevious).Row
crt = Range("I:I").Find("CRT").Row
crn = Range("I:I").Find("CRN").Row
mrt = Range("I:I").Find("MRT").Row
mrn = Range("I:I").Find("MRN").Row
Cells(crt, 9).Value = ""
Cells(crn, 9).Value = ""
Cells(mrt, 9).Value = ""
Cells(mrn, 9).Value = ""
crn = crn + 1
If crn > c Then
crn = 2
End If
Cells(crn, 9).Value = "CRN"
crt = crt + 1
If crt > c Then
crt = 2
End If
Cells(crt, 9).Value = "CRT"
mrn = mrn + 1
If mrn > m Then
mrn = c + 1
End If
Cells(mrn, 9).Value = "MRN"
mrt = mrt + 1
If mrt > m Then
mrt = c + 1
End If
Cells(mrt, 9).Value = "MRT"
End Sub

一応、目的は達成しています。

投稿日時 - 2015-12-11 20:55:10

お礼

回答ありがとうございます。
FindメソッドでCat0,1それぞれの最下行を取得し、変数に取り込んだ現在の行と比べて処理を分岐する方法ですね。

実際に使うときには"CRT","CRN","MRT","MRN"を配列に取り込んで、現在行を調べるところからFor~Next文で回したほうが良さそうなのでそのようにさせていただきます。

投稿日時 - 2015-12-14 12:27:00

ANo.2

こんにちは
どのような感じでデータが増えるのか分からないですけど、
Catのパターンが増え、1パターンの数が15から変動し、
各Catパターンの中で判定する文字と文字数が変わるのに対応するとしたら、

Sub hoge4()
  Dim Wb As Workbook
  Dim Ws As Worksheet
  Dim h As Long
  Dim i As Long
  Dim j As Variant
  Dim k As Long
  Dim r As Variant
  Dim t   As Range
  
  'Cat 1パターン数
  Const Cat As Long = 15
  
  'Cat パターン
  ReDim v(1 To 5, 1 To 1)
  v(1, 1) = "CRT,CRN"
  v(2, 1) = "MRT,MRN"
  v(3, 1) = "ABC,CDE"
  v(4, 1) = "FGH,IJK,LMN"
  v(5, 1) = "OPQ"
  
  Set Wb = ThisWorkbook
  Set Ws = Wb.Sheets(3)
  Set t = Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp)).Offset(, 9)
  j = t.Value
  
  k = 1
  For h = 1 To UBound(j, 1) Step Cat
    For i = 1 To Cat
      If j(h + i - 1, 1) <> "" Then
        r = InStr(1, v(k, 1), j(h + i - 1, 1))
        If r > 0 Then
          If h + i - 1 = Cat * k Then
            j(h, 1) = j(h + i - 1, 1)
            j(h + i - 1, 1) = ""
          Else
            j(h + i, 1) = j(h + i - 1, 1)
            j(h + i - 1, 1) = ""
            i = i + 1
          End If
        End If
      End If
    Next i
    k = k + 1
  Next h
  
  Application.ScreenUpdating = False
  t.Value = j
  Application.ScreenUpdating = False
End Sub

とかでしょうか?

投稿日時 - 2015-12-11 14:31:32

お礼

ありがとうございます。
配列内で処理することにより、書式設定の問題もクリアされています。
助かりました。

投稿日時 - 2015-12-14 12:26:46

ANo.1

こんにちは
データは何かしらのパターンで増えるのですか?
Ws.Range("A1:AO" & EndRow).Value = mtxNI
は、
Ws.Range("A1:J" & EndRow).Value = mtxNI
の間違いでしょうか?

どこが、あまりいい処理とは思えないのか分かりませんし、
どのようなコードが適しているのかも良く分かりませんし、
何故、クラスモジュールの話がでてくるのかも良く分かりません。

色々な方法が有るとは思いますけど、
Sub hoge3()
  Dim Wb As Workbook
  Dim Ws As Worksheet
  Dim j As Range
  Dim t As Range
  Dim r As Range
  
  Set Wb = ThisWorkbook
  Set Ws = Wb.Sheets(3)
  
  Set j = Ws.Range("J:J")
  Ws.Range("J1").Insert xlShiftDown
  
  On Error Resume Next
  Set t = j.SpecialCells(xlCellTypeConstants)
  On Error GoTo 0
  
  If t Is Nothing Then Exit Sub
  
  Application.ScreenUpdating = False
  For Each r In t
    Select Case r.Value
      Case "CRT", "CRN"
        If r.Row > 16 Then
          j(2, 1) = r.Value
          r.Value = ""
        End If
      Case "MRT", "MRN"
        If r.Row > 31 Then
          j(17, 1) = r.Value
          r.Value = ""
        End If
      Case Else
      
    End Select
  Next r
  Application.ScreenUpdating = False
End Sub
とかも。

投稿日時 - 2015-12-11 12:13:15

お礼

ありがとうございます。
J1セルを挿入して一つ下にずらしてから処理する方法ですね。
書式設定ごとずれるのでその処理が必要になるかと思いますが、動作確認できました。

あまりいい処理とは思えない理由は、Cat0,1共に同数でなければならない制約がつきますし、仰るようにデータ自体が増える可能性があるので、その際にコード書き直すことになるなぁ、というところです。
Cat0,1の最上行と最下行を変数に取り込んで処理するしかないのかなと思っているのですが、もっと平易というか、保守性が高く、無駄のない、可読性に優れたコードが無いものかと思い、質問させていただきました。
クラスモジュールの件は、私自身がまったくそれを理解しておらず、以前に読んだクラスモジュールの説明でおぼろげに、こういう処理に適しているのかと思っただけですので的外れなようであればご放念ください。

投稿日時 - 2015-12-11 12:35:18

あなたにオススメの質問