
BMIの結果から、痩せ・標準・やや肥満・肥満 の4つに判定したいのですが、下記のコードを実行しても反映されません。xlToRightをしているので自動的に右に進んでいくものだと思っていたのですが…。
'求められたBMIで判定をし該当セルに書き込む より下を確認して頂きたいです。
よろしくお願いします。
Sub report5()
Dim i As Integer, j As Integer, students As Integer
Dim lastRow As Integer, firstClm As Integer
Dim iStart As Integer, iEnd As Integer
Dim height(5) As Single, weight(5) As Integer
Dim heightStandard(5) As Double, BMI(5) As Double
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
firstClm = Cells(lastRow, "A").End(xlToRight).Column
students = 5
' Debug.print lastRow & "/" & firstClm
iStart = lastRow - students + 1
iEnd = lastRow
For i = 1 To students
'身長と体重を配列の中に保存する
height(i) = Cells(i + 29, "C") / 100
weight(i) = Cells(i + 29, "D")
'標準体重とBMIを求めて配列の中に保存する
'標準体重kg=22*(身長m)^2
Cells(i + 29, "E") = 22 * (Cells(i + 29, "C") / 100) ^ 2
'標準体重とBMIを該当セルに書き込む
Cells(i + 29, "F") = Cells(i + 29, "D") / (Cells(i + 29, "C") / 100) ^ 2
'求められたBMIで判定をし該当セルに書き込む
If Cells(i + 29, "F") <= 18.5 Then
result = "痩せ"
ElseIf Cells(i + 29, "F") <= 25 Then
result = "標準"
ElseIf 25.1 <= Cells(i + 29, "F") And Cells(i + 29, "F") <= 30 Then
result = "やや肥満"
ElseIf 30.1 <= Cells(i + 29, "F") And Cells(i + 29, "F") < 50 Then
result = "肥満"
End If
Next i
End Sub

A 回答 (6件)
- 最新から表示
- 回答順に表示
No.6
- 回答日時:
連投、しつこくなり申し訳ありません
余計な事ばかり書き、ご質問にきちんと回答していませんでした
>実行しても反映されません。
セルに書き出す処理がされていません(1行足せば処理できるはず)
result代入後に出力します
End If
Cells(i + 29, "G") = result
Next i
自身の回答#4を読み返し
(A列左に列を増やす場合やA列に値がある場合など正しく取得できない)などと指摘したにもかかわらず、示した参考コードは考慮されていません
For i = iStart To iEnd や Cells(i, "E")などを使いたい為と言っても
A列(ターゲット列)左に列を追加(削除)したりしたら機能しなくなりますから、自身の回答に矛盾します
カラムを"E""C"など定数ではなく
基準カラムからOffsetで相対的なセルを指定する必要があります
部分サンプル(一例)を書き直すと
firstClm = targetCell.Column
'1つ下の行
iStart = targetCell.Offset(1).Row
・
・
For i = iStart To iEnd
With Cells(i, firstClm)
.Offset(, 3) = 22 * (.Offset(, 1) / 100) ^ 2
.Offset(, 4) = .Offset(, 2) / (.Offset(, 1) / 100) ^ 2
Select Case .Offset(, 4).Value
ご質問を反故するような回答で申し訳ありませんでした
No.5
- 回答日時:
コードを書く時に名前としてしまいました・説明と不一致訂正します
What:="名 前" ×
What:="氏 名" ○
サイトの調整で連続半角スペースが削除されるようですので
実際のセルの値をコード内にコピペをすると間違いがないと思います
No.4
- 回答日時:
こんにちは
ご質問のコード、添付図(表組)の場合
>if else
ご質問のようなケースではSelect case で分岐した方が判り易いような気がします
また、Cells(i + 29, "F")のようにコード内で繰り返し記す必要がある場合は
変数などに代入したりWithなどで括ると良いかも知れないと思います
(Select caseならまとまる)
既に指摘されている(起点を特定する部分)ですが
最初に 定数 B を、End(xlToRight).Column使用している事から
限られた条件下でのみ機能しますがロジック的には破綻しているように思います
(A列左に列を増やす場合やA列に値がある場合など正しく取得できない)
限られた条件でのみならば、そもそも定数設定をすれば良い事になります
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
B列最終行(値のある最大行№)を取得
firstClm = Cells(lastRow, "A").End(xlToRight).Column
A列lastRow行 で Ctrlキー+→キーを押した時のセル列№
students = 5
定数5
' Debug.print lastRow & "/" & firstClm
'図の場合
iStart = lastRow - students + 1
iStart =30=34-5+1
iEnd = lastRow
iEnd =34=34
ですかね
と言う事は ループは For i = iStart To iEnd で良い事になります
従って Cells(i + 29, "C") / 100 ではなく
Cells(i , "C") / 100 で良いと思います。
特定セルを取得する方法(一例)
Findを使いますので少しアイデアや工夫が必要ですが図の場合、
氏名の値をシート上で一意の値に変更します
例えば 氏 名 氏 半角スペース×3 名 などして検索すれば入力されているセルを取得できます
コード例 Find Select Case
Sub test0()
Dim i As Integer, students As Integer
Dim iStart As Integer, iEnd As Integer
Dim targetCell As Range
'名 前と入力されているセルを探す
Set targetCell = ActiveSheet.UsedRange.Find(What:="名 前", LookIn:=xlValues, LookAt:=xlWhole)
If Not targetCell Is Nothing Then
'あれば 見つかったセルを基準に
'1つ下の行
iStart = targetCell.Offset(1).Row
'一番下の値のある行
iEnd = Cells(Rows.Count, targetCell.Column).End(xlUp).Row
students = iEnd - iStart + 1
Else
'無ければ
MsgBox "名 前 が見つかりません"
Exit Sub '実行を中止
End If
'データ内を繰り返し処理
For i = iStart To iEnd
'身長と体重を配列の中に保存する
'#意味わからず
'height(i) = Cells(i, "C") / 100
'weight(i) = Cells(i, "D")
'標準体重とBMIを求めて配列の中に保存する
'標準体重kg=22*(身長m)^2
Cells(i, "E") = 22 * (Cells(i, "C") / 100) ^ 2
'標準体重とBMIを該当セルに書き込む
Cells(i, "F") = Cells(i, "D") / (Cells(i, "C") / 100) ^ 2
'求められたBMIで判定をし該当セルに書き込む
Dim result As String
Select Case Cells(i, "F").Value
Case Is <= 18.5
result = "痩せ"
Case 18.6 To 25
result = "標準"
Case 25.1 To 30
result = "やや肥満"
Case Else
result = "肥満"
End Select
'判定をG列に書き込み
Cells(i, "G") = result
Next i
End Sub
studentsは不要?
ほぼコピペなので
配列や出力に関してや計算内容については考えていません
例のコードを使用する場合の必要知識 調べる事
ActiveSheet.UsedRange.Find
If Not targetCell Is Nothing Then
Select Case
自動記録などで確かめるコード、
Ctrlキー+→キーを押した時のセル
シート上の挙動 (A列に値を入れる、途中に空セルを配置するなど)
No.3
- 回答日時:
どのセルに値を出力するのか指定してないね。
”result” という共通する変数に判定結果を代入しているだけですので、判定結果が表の上に反映されることは永遠にありません。
そもそも
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
firstClm = Cells(lastRow, "A").End(xlToRight).Column
students = 5
' Debug.print lastRow & "/" & firstClm
iStart = lastRow - students + 1
iEnd = lastRow
が機能していない。
あと、
>xlToRightをしているので自動的に右に進んでいくものだと思っていたのですが…。
勘違いですよ。よく確認してください。
・・・余談・・・
配列変数にする必要ないと思うんだ。
No.2
- 回答日時:
>xlToRightをしているので自動的に右に進んでいくものだと思っていたのですが…。
進みませんよ。
単に右端のセルを取得するだけです。
今回はA列が空白なので実行するとデータのあるB列を選択するでしょうね。
実際A列のセルを選択して Ctrl キーと → を同時に押せば隣のB列のセルに移動します。
本当に一番右を取得したいなら、B列から始めないとダメでしょ。
今回のコードは
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
firstClm = Cells(lastRow, "A").End(xlToRight).Column
iStart = lastRow - students + 1
iEnd = lastRow
についてはコード上使われていないようですし、配列に格納と言う割には結局セルアドレスを使用してます。
即ちご質問の件もセルの列を指定して書き込むとしたら、使う意味はありません。
ちなみにgooでもですが知恵袋でもBMIの質問は毎年ありますので、過去の質問を検索すると参考になる物が見つかるかも知れません。
⇒ここ5年程は他言語に変わってきているかもですから、ExcelVBAである事を見落とさないように。
No.1
- 回答日時:
「xlToRightをしているので自動的に右に進んでいくものだと思っていたのですが…。
」の「自動的に右に進んでいく」というのは, いったい「何が」自動的に右に進んでいく, ということ?i+29 の意味もわからん. 「29」ってどこから出てきた?
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
プロが教えるわが家の防犯対策術!
ホームセキュリティのプロが、家庭の防犯対策を真剣に考える 2組のご夫婦へ実際の防犯対策術をご紹介!どうすれば家と家族を守れるのかを教えます!
-
なぜこんな初歩的なVBAのIf文でエラーか発生して使えないのか、全く理解出来ません。誰か助けてくださ
Visual Basic(VBA)
-
Excel VBAでAA(BBB) → BBB.AA に置換したい
Visual Basic(VBA)
-
初めてマクロを入力しますが、テキストとおりに入力したのに構文エラーです。修正を教えてください。
Visual Basic(VBA)
-
-
4
【VBAエラー】Nextに対するForがありません 対策について
Visual Basic(VBA)
-
5
ListBox1をClickしたときのイベント
Visual Basic(VBA)
-
6
Excel VBAのデバッグ
Visual Basic(VBA)
-
7
ファイル全てを .xlsm に変更したところ、プログラムが途中で落ちてしまっています
Visual Basic(VBA)
-
8
VBAリストボックスで選択した後
Visual Basic(VBA)
-
9
マクロ実行時、自動で背景色を変えたい。 C列にあるチェックボックスをチェックするとB列に「TRUE」
Visual Basic(VBA)
-
10
VBAの計算について
Visual Basic(VBA)
-
11
VBA コードの意味を教えて下さい。
Visual Basic(VBA)
-
12
エクセル 2つの列にある値の完全一致を抜き出すVBA
Visual Basic(VBA)
-
13
VBAで重複データを確認したい
Visual Basic(VBA)
-
14
ExcelVBA 日付変更
Visual Basic(VBA)
-
15
VBAでfunctionを利用しようとしたときに「引数は省略できません」というエラーが出ます
Visual Basic(VBA)
-
16
VBAコードで質問があります
Visual Basic(VBA)
-
17
VBA処理追加 こちらでご教示頂いたのですが回答完了させてしまいましたのでこちらからまた質問させてく
Visual Basic(VBA)
-
18
エクセルVBA コードが同じでもファイルによって処理速度が大きく変わるのはなぜ
Visual Basic(VBA)
-
19
VBA言語プログラミング
Visual Basic(VBA)
-
20
【マクロ】表への繰り返し転記について
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
このカテゴリの人気Q&Aランキング
-
4
送付元、送付先が同じ大きさの...
-
5
マクロを教えてください。
-
6
【VBA】色フィルタについて
-
7
マクロで最終行を取得したい
-
8
エクセルのマクロについて教え...
-
9
VBA チェックボックスで
-
10
VBA で エクスプロー操作
-
11
エクセルVBA 既存エクセルを開...
-
12
VBA シートのボタン名を変更し...
-
13
vba初心者です
-
14
グラフの交点の求め方(Excel)
-
15
エクセルのマクロについて教え...
-
16
Excel VABについて 下記記述が...
-
17
Application.ScreenUpdating = ...
-
18
エクセルのエラーメッセージ「4...
-
19
Excel マクロ VBA プロシー...
-
20
エクセルVBA テキストボックス...
おすすめ情報
公式facebook
公式twitter