忍者ブログ
日常だったりネタだったり作品の進捗だったり……色々書きます。不定期に。
03
  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 7
  • 8
  • 9
  • 10
  • 11
  • 12
  • 13
  • 14
  • 15
  • 16
  • 17
  • 18
  • 19
  • 20
  • 21
  • 22
  • 23
  • 24
  • 25
  • 26
  • 27
  • 28
  • 29
  • 30
  • 31
  • 管理画面

    [PR]

    ×

    [PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。

    VBA「演習-学生名簿」続き7

    こんばんは若槻です。GWまであと1日。GW入ったら仕上げられる奴は
    なるべく全部仕上げられるように頑張りたいと思います(-ω-)


    さて、それでは本日はそろそろ仕上げなのでまたVBAで。


    ====================================================
    ◎システム名 「演習-学生名簿」
    ====================================================
    ~現在ある内容~
    ・グループ分け      ←終了
    ・学年別  ←簡単1      ←終了
    ・学校別         ←終了
    ・性別ごと ←簡単2   ←終了
    ・配役配置        ←終了
    ・試合          ←終了
    ・検索
    ・選抜
    ・動き
    ・条件別グループ分け

    本日は「選抜」をおしゃべりします。

     

    8.選抜
    ○やりたいこと
    前回の「試合」同様単純にメンバーを振り分けているだけです。
    A~Fの6グループに適当に11人振り分ける

    ○ソース
    ~~~~~~~ソース1.-ここから~~~~~~~~
    '============================================================
    '選抜抜き出し
    '============================================================
    Sub Senbatu()
    [1]
      SheetSet
      DontLook
     
      SyokiCopy
      WH2.Range("1:1").Delete
     
      WH11.Cells.Delete
      '項目名の入力
      WH11.Range("A1,G1").Value = "選抜タイプ"
      WH11.Range("B1,H1").Value = "名前"
      WH11.Range("C1,I1").Value = "性別"
      WH11.Range("D1,J1").Value = "学校"
      WH11.Range("E1,K1").Value = "学年"
     

      '罫線を引く-2重線
      WH11.Range("A1:E1").Borders(xlEdgeBottom).LineStyle = xlDouble
      WH11.Range("G1:K1").Borders(xlEdgeBottom).LineStyle = xlDouble
     
      '罫線を引く-中太線
      WH11.Range("A12:E12").Borders(xlEdgeBottom).Weight = xlMedium
      WH11.Range("A23:E23").Borders(xlEdgeBottom).Weight = xlMedium
      WH11.Range("G12:K12").Borders(xlEdgeBottom).Weight = xlMedium
      WH11.Range("G23:K23").Borders(xlEdgeBottom).Weight = xlMedium
     
      '罫線を引く-囲い線1
      WH11.Range("A1:E1").Borders(xlEdgeTop).LineStyle = xlContinuous
      WH11.Range("E1:E34").Borders(xlEdgeRight).LineStyle = xlContinuous
      WH11.Range("A34:E34").Borders(xlEdgeBottom).LineStyle = xlContinuous
      WH11.Range("A1:A34").Borders(xlEdgeLeft).LineStyle = xlContinuous
     
      '罫線を引く-囲い線2
      WH11.Range("G1:K1").Borders(xlEdgeTop).LineStyle = xlContinuous
      WH11.Range("K1:K34").Borders(xlEdgeRight).LineStyle = xlContinuous
      WH11.Range("G34:K34").Borders(xlEdgeBottom).LineStyle = xlContinuous
      WH11.Range("G1:G34").Borders(xlEdgeLeft).LineStyle = xlContinuous
     
      '罫線を引く-区切り線
      WH11.Range("A1:A34").Borders(xlEdgeRight).LineStyle = xlContinuous
      WH11.Range("G1:G34").Borders(xlEdgeRight).LineStyle = xlContinuous
     
     
      '選抜名入力
      WH11.Range("A2:A12").MergeCells = True
      WH11.Range("A2").Value = "選抜A"
      WH11.Range("A13:A23").MergeCells = True
      WH11.Range("A13").Value = "選抜B"
      WH11.Range("A24:A34").MergeCells = True
      WH11.Range("A24").Value = "選抜C"
      WH11.Range("G2:G12").MergeCells = True
      WH11.Range("G2").Value = "選抜D"
      WH11.Range("G13:G23").MergeCells = True
      WH11.Range("G13").Value = "選抜E"
      WH11.Range("G24:G34").MergeCells = True
      WH11.Range("G24").Value = "選抜F"
     
      '中央寄せ
      WH11.Range("A1:E1").HorizontalAlignment = xlCenter
      WH11.Range("G1:K1").HorizontalAlignment = xlCenter
      WH11.Range("A2,A13,A24,G2,G13,G24").HorizontalAlignment = xlCenter
     
      '選抜-太字と角度変更
      WH11.Range("A2,A13,A24,G2,G13,G24").Font.Size = 14
      WH11.Range("A2,A13,A24,G2,G13,G24").Font.Bold = True
      WH11.Range("A2,A13,A24,G2,G13,G24").Orientation = 45
     
     
    [2] 
      '選抜A
      h = 2
      Do Until h > 12
        GroupNo = 1
        SenbatuKaiten
      Loop
     
      '選抜B
      h = 13
      Do Until h > 23
        GroupNo = 1
        SenbatuKaiten
      Loop
     
      '選抜C
      h = 24
      Do Until h > 34
        GroupNo = 1
        SenbatuKaiten
      Loop
     
      '選抜D
      h = 2
      Do Until h > 12
        GroupNo = 2
        SenbatuKaiten
      Loop
     
      '選抜E
      h = 13
      Do Until h > 23
        GroupNo = 2
        SenbatuKaiten
      Loop
     
      '選抜F
      h = 24
      Do Until h > 34
        GroupNo = 2
        SenbatuKaiten
      Loop
     
     
    [3] 
      '列幅のオートフィット
      LR = WH11.UsedRange.Columns.Count
      For i = 1 To LR
        WH11.Rows(i).EntireColumn.AutoFit
      Next
     
      WH11.Select
      WH11.Range("M1").Select
     
      OKLook
    End Sub
     ~~~~~~~ソース1.-ここまで~~~~~~~~

    ソース1でやってること→メイン動作
    [1]初期動作
     1.学生一覧をコピーして1行目の項目行を削除
     2.シート「選抜」内のデータを空にする
     3.項目名を格納 
     4.各所に罫線を引く
     5.グループ名を入れてセルを結合
     6.中央寄せやフォント等の変更を行う

     ※「Range("A1").Font.Size = 14」
      →A1のフォントサイズを14にする。ここで指定される値は
       通常のExcelで設定する値と同様に考える
     ※「Range("A1").Font.Bold = True」
      →A1のフォントに太字が追加される(外す場合はFalseにする)
      →ちなみに斜体は「.Italic = True」にすればよい
     ※「Range("A1").Orientation = 45」
      →A1の配置が45度の角度で傾く


    [2]各グループに振り分け。変数hは行数、変数GroupNoは列数
     ※GroupNoの場合、A~Cが1、D~Fが2となる
     →マクロSenbatuKaitenを呼び出し(後述)
    [3]最終処理
     →最終列までのオートフィット


    ~~~~~~~ソース2.-ここから~~~~~~~~
    '値入れ
    Sub SenbatuKaiten()
      LG = WH2.Range("A65536").End(xlUp).Row
      Randomize
      j = Int(Rnd() * LG) + 1
      Select Case GroupNo
        Case 1
          WH11.Range("B" & h).Value = WH2.Range("B" & j).Value
          WH11.Range("C" & h).Value = WH2.Range("D" & j).Value
          WH11.Range("D" & h).Value = WH2.Range("E" & j).Value
          WH11.Range("E" & h).Value = WH2.Range("F" & j).Value
        Case 2
          WH11.Range("H" & h).Value = WH2.Range("B" & j).Value
          WH11.Range("I" & h).Value = WH2.Range("D" & j).Value
          WH11.Range("J" & h).Value = WH2.Range("E" & j).Value
          WH11.Range("K" & h).Value = WH2.Range("F" & j).Value
      End Select
      WH2.Range(j & ":" & j).Delete
      h = h + 1
    End Sub
     ~~~~~~~ソース2.-ここまで~~~~~~~~

    ソース2でやってること→値の転記
     1.ランダムで選んだ値をjに代入
     2.GroupNoの値によって場合分けをし、データを転記
     3.転記された元データの行を削除

    e47a6309.JPG















    以上で「選抜」は終了です。
    お疲れ様でした。


    ~おまけ~
    「同一セル内でもこの部分だけを変えたい!」ということってありませんか?
    そんな時はこれ。

    「Characters(開始位置、文字数)」

    配置的には

    「Range("A1").Characters(4, 3) .Font.Size = 15」

    で、たとえばA1に「AbcDefGhi」という文字列が入っている場合、
    上の設定だと「Def」の部分の文字サイズが15になります。
    ※ちなみに同一セル内に複数の設定を入れることも可能

    <Ex>
    1.Range("A2").Value = Range("A1").Value
      WH11.Range("A2").Characters(1, 1).Font.Italic = True
    →1文字目だけ斜体になる
     
    2.Range("A3").Value = Range("A1").Value
      Range("A3").Characters(1, 1).Font.Bold = True
    → 1文字目だけ太字になる
     
    3.Range("A4").Value = Range("A1").Value
      With Range("A4")
        .Characters(1, 1).Font.Bold = True
        .Characters(2, 1).Font.Italic = True
        .Characters(1, 1).Font.Size = 15
      End With
    →1文字目が太字でフォントサイズ15に、2文字目が斜体になる
     

    07a3741e.JPG







     


    拍手[1回]

    PR

    お名前
    タイトル
    文字色
    URL
    コメント
    パスワード   Vodafone絵文字 i-mode絵文字 Ezweb絵文字
    非公開コメント
    この記事にトラックバックする:
    [469]  [468]  [467]  [466]  [465]  [464]  [463]  [461]  [460]  [459]  [458
    カレンダー
    02 2024/03 04
    S M T W T F S
    1 2
    3 4 5 6 7 8 9
    10 11 12 13 14 15 16
    17 18 19 20 21 22 23
    24 25 26 27 28 29 30
    31
    ブログ内検索
    最新コメント
    [05/27 きり]
    [01/13 きり]
    [06/06 わんこ]
    [03/30 サイトウ]
    [06/09 yu]
    カウンター
    アクセス解析


    フリーエリア
    コガネモチ


        ◆ graphics by アンの小箱 ◆ designed by Anne ◆

        忍者ブログ [PR]