データが存在しない部分を先着２つ集めたい

質問

データが存在しない部分を先着２つ集めたい

VBA初心者です。まだVBAがどういうものなのか、どうやって動かすかもよくわかっていないので難しい知識はないのですが、職場でマクロ作成を依頼され、右も左もわからず質問させて頂いた次第です。どうかよろしくお願いいたします。

作りたいマクロは、「６×６の表にデータがあり、各行ごとに"データがないセル"を左から２つまで取得してその名前を別の列に縦に記載する」というものです。（添付ファイル参照）

データがない(空欄の)セルを一番左から順番に２つ取得したいんです。
もし空欄セルが１つしかない場合はその１つだけを書きます。
１つのシートの中にこういう表がいくつかある状態で、また表によっては６×７であったり７×５になったり、サイズは変動するようです。

なので基本の形さえわかれば後は細かいところを変えて全てに使えると思うのですが・・・どうも組み方がわからず、といった状態です。あれこれ検索で調べてみたのですが目的とするものが見つかりませんでした。

初心者丸出しな質問で大変恐縮ですが、何卒よろしくお願いします！

回答No.3

jcctaira

まだVBAがどういうものなのか…
ということですが、先ず重要なのは「使う人」の立場になって、どういうVBAを作成するかです。
EXCELでは大きく２つの方法があると思います。
1.ユーザ関数で対応する方法
2.イベント（ボタンを押すことやセルの値に入力生した時等）でVBAを起動する方法

どちらも一長一短がありますが、今回の仕様をみるとユーザ関数の方が良いかと思います。
理由は
・「サイズは変動する」を使う方が自由に設定できる。
・項目名の位置（２行目）、表示数（２つ目まで）も使う方が自由に設定できる。
・入力した時点ですぐに再表示できる。

【使い方】
セルJ3に　
　=検索結果(C3:H3)　　 　　…集計範囲(C3:H3),（表示件数(2件),項目行(2行目）　
J4以降は式をコピーして下さい。

他に次のように指定できます。
　=検索結果(C3:I3,3)　　　…集計範囲(C3:I3),表示件数(3件),項目行(3行目）　
　=検索結果(C3:E3,3,1)　　…集計範囲(C3:E3),表示件数(3件),項目行(1行目）　

【VBA】
Function 検索結果(検索セル As Range, Optional 表示件数 = 2, Optional 項目名行 = 2) As String
　Dim セル As Range
　Dim 件数 As Integer

　For Each セル In 検索セル
　　　If セル = "" Then
　　　　　件数 = 件数 + 1
　　　　　検索結果 = 検索結果 & Cells(項目名行, セル.Column) & ","
　　　　　If 件数 >= 表示件数 Then Exit For
　　　End If
　Next
　If 検索結果 <> "" Then 検索結果 = Left(検索結果, Len(検索結果) - 1)
End Function

マクロを覚えることは結構大変ですが、VBAの基本を勉強しながら実践で頑張って下さい。

回答No.2

米沢 栄蔵（@YON56）

画面に表示されたもので、セルJ3～J8にデータを書き込むマクロを書きます。

Dim A,B,C,D,E,F
Dim AAA()

A = Application.WorksheetFunction.CountA(Range("C2:I2"))
Redim AAA(A)
For B=1 To A
AAA(B)=Cells(2,B+2).Value
Next B

Range("J3:J8")=""
C=Application.WorksheetFunction.Max(Range("B3:B8"))
For D=1 To C
E=0
For B=1 To A
If Cells(D+2,B+1).Value="" Then
If E=0 Then
Cells(D+2,10)=Cells(D+2,10).Value & AAA(B)
Else
Cells(D+2,10)=Cells(D+2,10).Value & "," & AAA(B)
End If
E=E+1
If E=2 Then
Exit For
End If
End If
Next B
Next D

回答No.1

imogasi

質問の例を下記のごとく変えます
B１：F6　X-Vは列見出し的なものを考えています。第２行目からがデータです。
x y z u v
1 2 - 1 -
- 2 3 4 -
3 - 1 2 2
2 1 - 3 1
1 1 1 1 2
空白をーに変えた例にします。（左詰めにされないために、です）
結果は
H２、I2以下に
z v
x v
y
z

になります。
コードは標準モジュールに下記をコピペして実行します。
この質問処理にぴったりのFor　Each ・・　　ガ使えます。
'MsgBox cl.Address & " " & cl.Row & "行"を生かしてどういう処理の動きになるか
納得してください。
ーー
Sub test01()
mrow = 0
For Each cl In Range("b2:F6")
'MsgBox cl.Address & " " & cl.Row & "行"
If cl.Row > mrow Then
cnt = 0
End If
If cl = "-" Then
cnt = cnt + 1
If cnt < 3 Then
Cells(cl.Row, 7 + cnt) = Cells(1, cl.Column)
End If
End If
mrow = cl.Row
Next
End Sub
空白で判断するときは、If cl = "-" Thenは
If cl = "" Thenにします。
＞６×７であったり７×５になったり、サイズは変動するようです。
は
Range("b2:F6")を適当に変えてください。
一般化するのは質問者にはいまの段階では過ぎると思うので略。

ーーー
VBAだけでなく、VBAで出来ることを頭に置きつつ、プログラムを組み立てるのは、興味を持って、長年経験を積まないと会得できない。特に簡潔なプログラムにするには。