レッスン-投稿一覧パソコン仕事５倍塾ポータル

投稿/コメントを表示します。

発展編1 フォローメールセミナー

森則彦さんの投稿

(投稿ID: 1616)

小川先生、お世話になっております。
ちょっと時間はかかりましたが何とか出来ました。

コレクションの概念をたえず意識しながら、自分なりにNETや、本などで勉強しつつ、
先生の考え方を参考にして、違った表現で書いてみました

最初よりは、やりたいことが何となくスラスラとイメージ出来る様になった気がします。
また、他の人が書いたプログラムも読める様になったと思います。

先生から見ればまだまだ知らない初心者でレベルの低い話ではあると思いますが、
他の人の書いたものも参考にしつつスラスラと出来る様になると、遥かかなたのVBAの達人。
頂上に向かって登っているときは楽し～いものですね。何歳になっても。

以下が練習問題の私の今の力の回答です。感想よろしくお願いします。

code
Sub ren212()
DeleteSheets

Dim fmWs As Worksheet, toWs As Worksheet, orWs As Worksheet
Dim rG As Range, aLrg As Range, keiSen As Range
Dim kaiSya As String
Dim mX As Long, toCnt As Long, kEi As Long, kGaku As Long
Set fmWs = Worksheets("main1")
Set orWs = Worksheets("main")
orWs.Range("b1").Sort key1:=Range("b1"), order1:=xlAscending, Header:=xlYes
mX = Range("b" & Rows.Count).End(xlUp).Row
Set aLrg = orWs.Range("b2", "b" & mX)
For Each rG In aLrg
If Not kaiSya = rG Then
If Not kaiSya = "" Then
Set keiSen = Worksheets(kaiSya).Range("b16", "k" & 15 + toCnt)
keiSen.Borders.LineStyle = xlContinuous
End If
fmWs.Copy after:=Worksheets(Worksheets.Count)
Set toWs = ActiveSheet
kaiSya = rG.Value
toWs.Name = kaiSya
kEi = 0
toCnt = 0
End If
With toWs.Range("b16")
.Offset(toCnt, 0).Value = Right(Year(rG.Offset(, 1).Value), 2)
.Offset(toCnt, 1).Value = Month(rG.Offset(, 1).Value)
.Offset(toCnt, 2).Value = Day(rG.Offset(, 1).Value)
.Offset(toCnt, 3).Value = rG.Offset(, 2).Value
.Offset(toCnt, 4).Value = rG.Offset(, 3).Value
.Offset(toCnt, 6).Value = rG.Offset(, 4).Value
kGaku = rG.Offset(, 5).Value
If kGaku >= 0 Then
.Offset(toCnt, 7).Value = kGaku
Else
.Offset(toCnt, 8).Value = kGaku
End If
kEi = kEi + kGaku
.Offset(toCnt, 9).Value = kEi
End With
toCnt = toCnt + 1
Next
Set keiSen = Worksheets(kaiSya).Range("b16", "k" & 15 + toCnt)
keiSen.Borders.LineStyle = xlContinuous
orWs.Activate
orWs.Range("a1").Sort key1:=Range("a1"), order1:=xlAscending, Header:=xlYes
End Sub

Sub DeleteSheets()
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In Worksheets
If Not ws.Name Like "main*" Then
ws.Delete
End If
Next
Application.DisplayAlerts = True
End Sub
/code

2015/08/21 09:22

ゲストさんのコメント

(コメントID: 2884)

森則彦さん:

添削返送します。すごくよくできてますね！サイコー！です☆

>先生から見ればまだまだ知らない初心者でレベルの低い話ではあると思いますが、

いえいえ、そんなことないです。このくらいできたら、相当のレベルですよ！

>頂上に向かって登っているときは楽し～いものですね。何歳になっても。

分かります (^^*
ひきつづき、お愉しみください☆

Sub ren212()
    DeleteSheets
    
    Dim fmWs As Worksheet, toWs As Worksheet, orWs As Worksheet
    Dim rG As Range, aLrg As Range, keiSen As Range
    Dim kaiSya As String
    Dim mX As Long, toCnt As Long, kEi As Long, kGaku As Long
    Set fmWs = Worksheets("main1")
    Set orWs = Worksheets("main")
    orWs.Range("b1").Sort key1:=Range("b1"), order1:=xlAscending, Header:=xlYes 'シンプルでいいですね！ ogawa
    mX = Range("b" & Rows.Count).End(xlUp).Row
    Set aLrg = orWs.Range("b2", "b" & mX)
    For Each rG In aLrg
        '以下のIf文内のロジック、しっかりしていますね！ ogawa
'        If Not kaiSya = rG Then
        If Not kaiSya = rG.Value Then 'value入れましょう ogawa
            If Not kaiSya = "" Then
                  Set keiSen = Worksheets(kaiSya).Range("b16", "k" & 15 + toCnt) '範囲選択の仕方、とてもうまい！スーパーエクセレント！！ v(^^* ogawa
                  keiSen.Borders.LineStyle = xlContinuous '一行で済ませる方法、よくご存じですね！ ogawa
            End If
            fmWs.Copy after:=Worksheets(Worksheets.Count)
            Set toWs = ActiveSheet
            kaiSya = rG.Value
            toWs.Name = kaiSya
            kEi = 0
            toCnt = 0
        End If
        'withの使い方、シブい！ ogawa
        With toWs.Range("b16")
            '以下３つ、 format関数を使うことにもチャレンジしてみてください！
            .Offset(toCnt, 0).Value = Right(Year(rG.Offset(, 1).Value), 2)
            .Offset(toCnt, 1).Value = Month(rG.Offset(, 1).Value)
            .Offset(toCnt, 2).Value = Day(rG.Offset(, 1).Value)
            .Offset(toCnt, 3).Value = rG.Offset(, 2).Value
            .Offset(toCnt, 4).Value = rG.Offset(, 3).Value
            .Offset(toCnt, 6).Value = rG.Offset(, 4).Value
            kGaku = rG.Offset(, 5).Value
            If kGaku >= 0 Then
                .Offset(toCnt, 7).Value = kGaku
            Else
                .Offset(toCnt, 8).Value = kGaku
            End If
            kEi = kEi + kGaku
            .Offset(toCnt, 9).Value = kEi
        End With
        toCnt = toCnt + 1
    Next
    Set keiSen = Worksheets(kaiSya).Range("b16", "k" & 15 + toCnt)
    keiSen.Borders.LineStyle = xlContinuous
    orWs.Activate
    orWs.Range("a1").Sort key1:=Range("a1"), order1:=xlAscending, Header:=xlYes
End Sub

'good! ogawa (^^*
Sub DeleteSheets()
    Dim ws As Worksheet
    Application.DisplayAlerts = False
    For Each ws In Worksheets
        If Not ws.Name Like "main*" Then
            ws.Delete
        End If
    Next
    Application.DisplayAlerts = True
End Sub

>小川先生、お世話になっております。
>ちょっと時間はかかりましたが何とか出来ました。
>
>コレクションの概念をたえず意識しながら、自分なりにNETや、本などで勉強しつつ、
>先生の考え方を参考にして、違った表現で書いてみました
>
>最初よりは、やりたいことが何となくスラスラとイメージ出来る様になった気がします。
>また、他の人が書いたプログラムも読める様になったと思います。
>
>先生から見ればまだまだ知らない初心者でレベルの低い話ではあると思いますが、
>他の人の書いたものも参考にしつつスラスラと出来る様になると、遥かかなたのVBAの達人。
>頂上に向かって登っているときは楽し～いものですね。何歳になっても。
>
>以下が練習問題の私の今の力の回答です。感想よろしくお願いします。

2015/08/21 17:30