学生番号と月日から検索をしたいのですが…

質問

ユーザーフォームに
学籍番号と月日を入力するボックスが2つあり、この二つから範囲内にあるセルを検索して、当てはまるセルに＋1したいと考えました。つまり、出席を入力したいマクロを作りたいのですが…全くうまく行きません。

原始的なコマンドで考えているのも原因かもしれませんが…次のようなマクロを書きました。

Private Sub CommandButton1_Click()

学生番号 = 日付出席.TextBox1.Value
　　'ただ、日付はいちいち2007年を入力するのが面倒だと思うので、"0317"を入力する形にしてあります。

日付 = 日付出席.TextBox2.Value
'現在のセルが空欄でない限り
For i = 0 To m - 1

'現在のセルが登録番号と同じ？(6段目から学籍が縦に並んでいます)
If Cells(i + 6, 1).Value - 学生番号 = 0 Then
s = 1
Else
s = 0
End If

'登録済み？5列目から日付が並んでいます。cells(4,2)に"2007"が入っています.
For k = 0 To 回数 - 1
If Cells(i + 6, 5 + k + 有無).Value - (日付 + Cells(4, 2) * 10000) = 0 Then
h = 1
Else
h = 0
End If

If s <> 0 And h <> 0 Then
Cells(i + 6, 5 + k + 有無) = 1
GoTo 1000
End If

Next k

'登録されていない＆その報告
If Cells(i + 6, 1).Value = "" Then
MsgBox "受講生登録していない番号を記入しています"
'報告できたから、抜け出し
Exit For

'if文の終了
End If

'出席を登録できるまで繰り返し
Next i

以上のようなVBAを書いたのですが、うまく行きません…。学籍番号と日付がクロスするセルに＋1するように手直ししていただけましたら、幸いです。

よろしくお願い致します。

回答No.2

noname#95859 · ベストアンサー

貴兄のスクリプトの構造を書くと
For i 文
-学生番号のサーチ ---ありであれば,s=1
-For k 文
--日付のサーチ ---ありであれば,h=1
--If s <> 0 And h <> 0 Then 出席状況インプット、そして GoTo 1000
-Next k
-登録されていない＆その報告 xxxx exit For
Next i
つまり、
学生番号を見つけた(外側のループ）-->日付を見つけた(内側のループ)-->登録（内側のループ）-->goto1000 ????

以下をチェックする必要があると思います。
（１）goto1000の行き先が明示されていません。
この gotoは、よくよく考えると、極めて不明です。と言うのは、登録すべきセルが判明、登録終了したのですから、
Private Sub CommandButton1_Click自体を終了しても良いわけです。for loopの中から、どこへ行く???

（２）日付のサーチ、　
If Cells(i + 6, 5 + k + 有無).Value - (日付 + Cells(4, 2) * 10000) = 0 Then
とありますが、変数iは間違いです。多分2007が入っている行と同じ位置だと思いますので
If Cells(４, 5 + k + 有無).Value - (日付 + Cells(4, 2) * 10000) = 0 Then
であるべきと思います。

（３）next kの次の行に書かれている、「'登録されていない＆その報告」は、
登録されていない「日付」のはずです。　学生番号のサーチのルーチンの中ですから、
「"受講生登録していない番号を記入しています"」はありえない。
「"受講生登録していない番号を記入しています"」の部分は、 Next i　の次の行に書かれるべきです。

（４）変数、「有無」と「回数」の初期設定がなされていません。

（５）2つ目の日付のサーチに入る条件に、S=1を入れる。
さもないと、大半の処理(m*回数)にて、[登録されていない＆その報告]
を実施することになります。

また、
If s <> 0 And h <> 0 Then
Cells(i + 6, 5 + k + 有無) = 1
の後ろに、日付出席.TextBox1.Value=""、日付出席.TextBox2.Value=""
を入れた方が、良いと思います。

以上を修正すれば、動くようになると思います。
---------------------------------------------------------
下記は提案です。
前提：次のデータは、シート名”Sheet1"に書かれていること。
- A列 B列 C列 D列 E列
4行目 xx 2007 3/16(金)　3/17(土)　3/18(日)
5行目 xx
6行目 1234 1
7行目 1235
8行目 1236 1
9行目 1237
10行目 1238 1
cells(4,2)には、2007が入っています。
6行目からは、学生番号が入っています
Cells(4,3)からは、日付が入っています。
日付が 3/16(金)と見えますが、実際の入力は　2007/3/16です。
書式設定で、曜日を表しています。"mm/dd (aaa)"

標準モジュール
---------------------------------------------------------
Sub main()
Dim 日付 As Date
Load 日付出席
日付出席.Show
End Sub

Function checkID(myArrayID As Variant, 学生番号 As String) As Integer
Dim r As Integer, temp As Integer, i As Integer
r = UBound(myArrayID, 1)
'学生番号の数を求める。1は行方向を意味します。
'myArrayIDはr行1列の配列です。
temp = 0
For i = 1 To r
If myArrayID(i, 1) = 学生番号 Then temp = i: Exit For
Next
checkID = temp '最後に checkID(function名）に入れた数値が戻り値
End Function

Function checkDate(myArrayDate As Variant, 日付 As Date) As Integer
Dim c As Integer, temp As Integer, j As Integer
c = UBound(myArrayDate, 2)
'登録日付の数を求める。 2は列方向を意味します。
'myArrayDateは1行c列の配列です。
temp = 0
For j = 1 To c
If myArrayDate(1, j) = 日付 Then temp = j: Exit For
Next
checkDate = temp '最後に checkDate(function名）に入れた数値が戻り値
End Function
-----------------------------------------------------------

イベントモジュール
-----------------------------------------------------------
Private Sub CommandButton2_Click()
Dim 日付 As Date
Dim 学生番号 As String

学生番号 = 日付出席.TextBox1.Value
temp日付 = 日付出席.TextBox2.Value
If 学生番号 = "" Or temp日付 = "" Then Exit Sub
' 未入力でボタン押下エラー対策

With Worksheets("Sheet1")
tempYear = .Cells(4, 2).Value
tempMonth = Mid(temp日付, 1, 2)
tempDay = Mid(temp日付, 3, 2)
日付 = DateSerial(tempYear, tempMonth, tempDay)

有無 = 0
回数 = 4
m = .Cells(65536, 1).End(xlUp).Row '最後の学生番号が書かれている行番号
k = .Cells(4, 256).End(xlToLeft).Column '最後の日付が書かれている列の番号

myArrayID = .Range(.Cells(6, 1), .Cells(m, 1)).Value '学生番号をメモリ上の配列に持ってくる
myArrayDate = .Range(.Cells(4, 3), .Cells(4, k)).Value '登録されている日付をメモリ上の配列に持ってくる
'実際のセルをサーチするのではなく、メモリー上をサーチする方がスピードは速い。

Rowpos = checkID(myArrayID, 学生番号) '当該学生番号が書かれている行番号（メモリ上）を知る
Colpos = checkDate(myArrayDate, 日付) ''当該日付が書かれている列番号（メモリ上）を知る
If Rowpos <> 0 And Colpos <> 0 Then
.Cells(Rowpos + 5, Colpos + 2).Value = 1
Else
If Rowpos = 0 Then myMessage = "学生番号(" & 学生番号 & ")が未登録"
If Colpos = 0 Then myMessage = "日付(" & 日付 & ")が未登録"
If Rowpos = 0 And Colpos = 0 Then myMessage = "学生番号(" & 学生番号 & ")、および 、日付(" & 日付 & ")が未登録"
MsgBox myMessage
End If
End With
日付出席.TextBox1.Value = ""
日付出席.TextBox2.Value = ""
End Sub

Private Sub UserForm_Activate()
'このルーチンの目的は、ワークシート上の」日付を普段は 03/16(金)と表示しておきますが、
'一旦、ユーザーフォームが出てきたら、入力時のフォーマット 0316に合わせて、入力時の間違いを
'防ぐ。
With Worksheets("Sheet1")
k = .Cells(4, 256).End(xlToLeft).Column '最後の日付が書かれている列の番号
.Range(.Cells(4, 3), .Cells(4, k)).NumberFormatLocal = "mmdd" '書式　mmddにします
End With
End Sub

Private Sub UserForm_Terminate()
'このルーチンの目的は、ワークシート上の」日付を普段は 03/16(金)と表示しておきますが、
'ユーザーフォームがクローズしたら、日付の表示を 03/16(金)に戻す
With Worksheets("Sheet1")
k = .Cells(4, 256).End(xlToLeft).Column '最後の日付が書かれている列の番号
.Range(.Cells(4, 3), .Cells(4, k)).NumberFormatLocal = "mm/dd (aaa)" '書式で曜日を表現します
End With
End Sub
------------------------------------------------------------------------

スクリプト中、
With Worksheets("Sheet1")
.Cells(4, 256).End(xlToLeft).Column
end with
とあるのは、ユーザーフォームを見に行ったり、シートを見に行ったりで、
明示的に指示しようとしたものです。必要ないかもしれません。

-------------------------------------------------------------------------

最後に、現在、貴兄は所謂「表」を作成しているわけですが、長い目で見ると、
年間の集計等が必要になるかも知れません。
単月の表のみならず、年間での集計、はたまた、数年間での集計を可能にする方法として、下記があると思います。
入力をデータベースの形で実行するのです。つまり
学生番号　日付　出欠 年度
1234 2007/03/17 1 2007
1235 2007/03/17 0 2007
1236 2007/03/17 1 2007
(年度は、関数で入力しますので、手入力はなし）

この形になっていれば、Pivotテーブルを使って、単月の表は即座に完成します。
また、年度での集計も即座に完了します。

スクリプトは、前提とした」データのもとでは、きちんと動くことを確認していますが、動かない場合は、ご連絡ください。

お礼

ありがとうございます。

goto文、報告等のご指摘も含めて、ありがとうございます。いろいろと勉強させていただきました。checkIDのIDは、大文字になっているから何か登録された変数なのだろうなぁ…等、自分でも考えながら利用させていただきました。その結果、ありがたいことに意図した動きをしてくれるようになりました。本当に感謝の気持ちでいっぱいです。

今回のマクロを、某サイトにおいて公開(無料)したいと思っております(自分だけでは、もったいないので…)。その際にも、Rich53さんに助けて頂いた旨を掲載しておきたいと思います(もし載せない方が良ければ、その旨を連絡いただけますと幸いです)。ありがとうございました。

失礼します。

回答No.3

zap35

おそらくこの処理は実業務では使用に耐えないと思います。その理由は最後の述べるとして、VBAサンプルを書きました

【前提】
想定したシートは以下の通りです
　　　　　Ａ列　　　　Ｂ列　…　　　Ｅ列　　　　　Ｆ列　　　　Ｇ列　　　　　Ｈ列　　
　　　　　　　　　　　　　　　　　　　　1回　　　　　2回　　　　　3回　　　　4回
４行目　学籍番号　2007　　　　20070301　　20070308　20070315　20070322　…右方向に続く
５行目　06-1000
６行目　06-1001
７行目　06-1002
８行目　06-1003
　以下続く

シートの４行目の日付（のようなもの）は整数値です。
Userform1にはTetxBox1、TextBox2、CommandButton1が配置されています

コマンドボタンがクリックされたときのマクロは以下になります
Private Sub CommandButton1_Click()
Dim resH, resV
　With ActiveSheet
　　resV = Application.Match(UserForm1.TextBox1.Value, .Range("A1:A65536"), 0)
　　If IsError(resV) Then
　　　MsgBox ("該当する学生がいません")
　　　UserForm1.TextBox1.SetFocus
　　　Exit Sub
　　End If

　　If Not IsNumeric(UserForm1.TextBox2.Value) Then
　　　MsgBox ("日付が数値ではありません")
　　　UserForm1.TextBox2.SetFocus
　　　Exit Sub
　　Else
　　　resH = Application.Match(.Cells(4, 2) * 10000 + Val(UserForm1.TextBox2.Value), _
　　　　　.Range("A4:IV4"), 0)
　　　If IsError(resH) Then
　　　　MsgBox ("日付が一致しません")
　　　　UserForm1.TextBox2.SetFocus
　　　　Exit Sub
　　　End If
　　End If
　　.Cells(resV, resH) = .Cells(resV, resH) + 1
　End With
End Sub

面倒とは思いますが、シートを先に示したとおりにして実行してみて下さい。動きが分かると思います。

でも実際のシートに適用しても動かないかもしれません。それは実際の学生番号は数字かもしれないからです。質問文を拝見して「文字型、整数型の違いを理解されていないのではないか」と思いました。変数の型をきちんと理解できないと思った動作をしないことがあります。

最後になぜ実務に耐えないかを述べます。それは、
「間違って入力してしまった場合、どこが間違ったか確認する方法がないし、入力を元に戻す手段もない」からです。これを防ぐためには入力ログを別シートに書いておく等の工夫が必要です。でも今それについて云々するより、マクロがきちんと動くようにがんばってみてください。

お礼

本当に、ありがとうございます。すっきりまとまったVBAのプログラムで、勉強させていただきました。ただ、自分の勉強不足で使いこなせませんでした。zap35へは、申し訳ない思いでいっぱいです。

また、
「文字型、整数型の違いを理解されていないのではないか」
は、その通りで、いまだに？？が続いております。ただ、自分の考えでは学生番号は"整数型"？と思ってもおります(たまに英字が入るのですが、それは数字に置き換えて全て数字で入力しております)。

まだまだです…。でも、本当にありがたいと感謝しております。

あと、今回のマクロを、某サイトにおいて公開(無料)したいと思っております(自分だけでは、もったいないので…)。その際にも、zap35さんに助けて頂いた旨を掲載しておきたいと思います(もし載せない方が良ければ、その旨を連絡いただけますと幸いです)。ありがとうございました。

失礼します。

回答No.1

nicotinism

案だけですが
Find メソッドを使えば学生番号のセルアドレスが求められます
そこで５列目から１・２・３・と日付が入っているのなら
日付出席.TextBox2.Value の日付の『日』の部分 + 5 - 1
をOffset プロパティで最終的な目的のセルを求められますよ。