Excel VBAについて

質問

早速ですがExcelVBAについて質問です。
年齢がN列にあるとき、M列に年代を入れたいと思います。（例：19才なら10代、30才なら30代）
以下のように作成しましたが、すべてに20と入ったり正常に動作しないときがあります。
Excelは2003で作成していますが、いずれ2007でも使いたいです。
もっと正確に実行できるコードを教えてください。

ワークシート関数での解決は望んでいません。データ数も多く他の作業もマクロで処理するのでマクロを希望しています。よろしくお願いします。
--------------------------
Sub ByAge()
Range("N1").Value = "年代別"
Dim i As Long, N As Integer
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 13).Value >= 60 And Cells(i, 13).Value < 70 Then
Cells(i, 14).Value = 60
ElseIf Cells(i, 13).Value >= 50 And Cells(i, 13).Value < 60 Then
Cells(i, 14).Value = 50
ElseIf Cells(i, 13).Value >= 50 And Cells(i, 13).Value < 60 Then
Cells(i, 14).Value = 40
ElseIf Cells(i, 13).Value >= 30 And Cells(i, 13).Value < 40 Then
Cells(i, 14).Value = 30
ElseIf Cells(i, 13).Value >= 20 And Cells(i, 13).Value < 30 Then
Cells(i, 14).Value = 20
End If
Next i
MsgBox "完了！"
End Sub
--------------------------

回答No.1

cj_mover · ベストアンサー

こんにちは。

ちょっと説明文と、ご提示のコードに不整合があるようですが、
説明を優先させます。

> 年齢がN列にあるとき、M列に年代を入れたいと思います。（
M列＝13列め
N列＝14列め

最下行の取得は、A列を基準。
N列の値＝年齢を、一の位で切り捨てた値を、
M列に

Sub ByAge()
　　Dim i As Long, N As Integer
　　Range("M1").Value = "年代別"
　　For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
　　　　Cells(i, 13).Value = (Cells(i, 14).Value \ 10) * 10
　　Next i
　　MsgBox "完了！"
End Sub

お礼

すっきりとしたわかりやすいコードですね。こんなに短くできるなんて…感動しました！
ありがとうございました。

補足

すみません、文章が間違いでコードが正しいです。
でもN列とM列を入れ替えたら正常に動作しました。

回答No.7

cj_mover

＃１、ｃｊです。気になったので追加レスしてみます。

> 以下のように作成しましたが、すべてに20と入ったり正常に動作しないときがあります。

> もっと正確に実行できるコードを教えてください。

＃１では、簡単さを意識して書いていたので、
あらためて、保守を意識したものを書いてみました。
　　セルの値のデータ型が何であれ、表示されている文字を取得して、
　　２桁の数字であれば、一の位を "0" に置換して年代を出力します。
　　このやり方は、セルへの入力や数式の建て方などにイレギュラーがあっても、
　　表示された年齢に対して処理しますから、誤った出力結果を避けることができます。
　　万が一、２桁の数値でない値（エラー値含む）だった場合は、
　　出力しないように書きましたから、
　　実行後に、空白セルを探せば容易に検証できるようになっています。
　　10歳未満、100歳以上の場合も空白セルになってしまいますが、特別に手当てしてあげてください。
もっと厳しくすることも考えましたが、難しくない程度に堅牢に、という狙いで、
メンテのし易さも考慮しています。

' ' =================================================================

Sub Re8291599c()

　　Dim r As Range
　　Dim sTmp As String

On Error GoTo Exit_

　　With Application
　　　　.ScreenUpdating = False
　　　　.EnableEvents = False
　　　　.Calculation = xlCalculationManual
　　　　.Interactive = False
　　　　.IgnoreRemoteRequests = True
　　End With

　　Columns("N").NumberFormatLocal = "G/標準"
　　Range("N1").Value = "年代別"

　　For Each r In Range("M2:M" & Cells(Rows.Count, 1).End(xlUp).Row)
　　　　sTmp = Trim$(r.Text)
　　　　If sTmp Like "##" Then
　　　　　　Mid(sTmp, 2) = "0"
　　　　　　r(1, 2).Value = sTmp
　　　　End If
　　Next

Exit_:

　　If Err Then MsgBox Err & vbLf & Err.Description, vbExclamation

　　With Application
　　　　.IgnoreRemoteRequests = False
　　　　.Calculation = xlCalculationAutomatic
　　　　.EnableEvents = True
　　　　.Interactive = True
　　　　.ScreenUpdating = True
　　End With

End Sub

' ' =================================================================

＃スレが盛り上がっちゃって、検証するのも大変でしょうけれど、
焦らず頑張ってください。

お礼

早速検証したところ、おっしゃる通りの結果になりました。こんなコードが自分でも書けたら、、、と思います。
度々ご尽力いただき本当にありがとうございました。

補足

このデータはこの処理後にピボットテーブルにすることを検討しているので、文字があっても、10歳未満、100歳以上の場合でも空白セルになってくれるのは助かります。

回答No.6

keithin

ありゃ、ＮとＭを入れ替えたらマクロを直し忘れました。

sub macro1r1()
　with range("N2:N" & cells(rows.count, "M").end(xlup).row)
　　.formula = "=IF(M2="""","""",IF(M2>=20,ROUNDDOWN(M2,-1),""""))"
　　.value = .value
　end with
　msgbox "DONE"
end sub

しつれいしました。

お礼

度々ありがとうございます！

回答No.5

kmetu

No3です

一応M列には数値しか入っていないという前提でやってますが、万が一数値以外が入力される可能性があるのでしたらIsNumericを利用して

Sub ByAgeSample()

Dim MyRange As Range

Range("N1").Value = "年代別"

For Each MyRange In Range("M2:M" & Range("A" & Rows.Count).End(xlUp).Row)

'If IsNumeric(MyRange.Value) Then　←　こちらより↓のほうがいいそうです。
If WorksheetFunction.IsNumber(MyRange.Value) Then
Select Case Int(MyRange.Value / 10)
Case 6
Range("N" & MyRange.Row).Value = 60
Case 5
Range("N" & MyRange.Row).Value = 50
Case 4
Range("N" & MyRange.Row).Value = 40
Case 3
Range("N" & MyRange.Row).Value = 30
Case 2
Range("N" & MyRange.Row).Value = 20
End Select
Else
MsgBox MyRange.Row & "行に数値以外が入力されています"
Range("M" & MyRange.Row).Select
Exit Sub
End If
Next

End Sub

などのようにしてください。

お礼

絶対数値しか入らないといいたいのですが、私以外の人が何名かで使用するのでそうはいいきれず...回避があったほうがいいと思いました。
勉強になります。ありがとうございました。

回答No.4

WindFaller

>年齢がN列にあるとき、M列に年代を入れたいと思います。
文章と、コードには矛盾があります。
最初はコードを優先させていただきます。

'//
Sub Ages_Class()
　Dim c As Range
　Dim i As Long
　Range("N1").Value = "年代別"
　i = Cells(Rows.Count, 1).End(xlUp).Row
　For Each c In Range("M2", Cells(i, 13))
　　If VarType(c.Value) = vbDouble Then
　　　c.Offset(, 1).Value = Int(c.Value / 10) * 10
　　 End If
　Next c
　MsgBox "完了！"
End Sub
'//

もし、文章どおり
>年齢がN列にあるとき、M列に年代
とするなら、

'//
Sub Ages_Class()
　Dim c As Range
　Dim i As Long
　Range("M1").Value = "年代別"
　i = Cells(Rows.Count, 1).End(xlUp).Row
　For Each c In Range("N2", Cells(i, 14))
　　If VarType(c.Value) = vbDouble Then
　　　c.Offset(, -1).Value = Int(c.Value / 10) * 10
　　 End If
　Next c
　MsgBox "完了！"
End Sub
'//

お礼

もし年齢列に文字が入っていても、エラーで中断することなく最終行まで処理してくれました。また100歳や5歳など入れた場合もちゃんと処理してくれました。
素晴らしいコードですね！ありがとうございました。

補足

すみません、コードが正しいです。両方書いていただき恐縮です。

回答No.3

kmetu

40代のところのIF文が間違ってることを除いては普通に動きそうですけど、正常に動作しないとは不思議ですね。うちでテストしても正常に動きました。何か他の要因があって正常に動かないのではないでしょうか。

とりあえずcase文を使ったサンプルを

Sub ByAgeSample()

Dim MyRange As Range

Range("N1").Value = "年代別"

For Each MyRange In Range("M2:M" & Range("A" & Rows.Count).End(xlUp).Row)

Select Case Int(MyRange.Value / 10)
Case 6
Range("N" & MyRange.Row).Value = 60
Case 5
Range("N" & MyRange.Row).Value = 50
Case 4
Range("N" & MyRange.Row).Value = 40
Case 3
Range("N" & MyRange.Row).Value = 30
Case 2
Range("N" & MyRange.Row).Value = 20
End Select

Next

MsgBox "完了！"

End Sub

お礼

私もこの場合IfよりSelect Caseのほうが確実と思い、何度が書いたのですがすべて失敗で動きませんでした。
このように記述するのですね。勉強になりました。
ありがとうございました。

回答No.2

keithin

＞年齢がN列にあるとき、M列に年代を入れたい

マクロでは逆になってますので，マクロの方が正しいとします。

sub macro1()
　with range("N2:N" & cells(rows.count, "N").end(xlup).row)
　　.formula = "=IF(M2="""","""",IF(M2>=20,ROUNDDOWN(M2,-1),""""))"
　　.value = .value
　end with
　msgbox "DONE"
end sub

補足

わかり難い質問にもかかわらず理解していただきありがとうございます。おっしゃる通り、マクロが正しいです。