皆さんこんばんは若槻です。件のシステムはちょろちょろと
難題風味になってはあっさり直ったりと意地悪加減がハンパない！
最近帰りが徐々に遅くなってます……（´д｀）

さて本日は先日の続きでVBAのおしゃべりです。
やっぱり隠しません←

====================================================
◎システム名　「演習-学生名簿」
====================================================

～現在ある内容～
・グループ分け
・学年別　　←簡単１
・学校別
・性別ごと　←簡単２　　　　←終了
・配役配置
・試合
・検索
・選抜
・動き
・条件別グループ分け（作成中

それでは今日は学年分けを解説しようと思います。
やってることの大半が「性別ごと」と同じようなものですから
大半は削ります。

※その前にお知らせ
この記事から以降は「プロシージャ」を「マクロ」と表記します。
理由→単純にプロシージャと入れるのが面倒だから（すみませんΣ

３．学年ごと
○やりたいこと
このマクロでやりたいのは学年ごとに人を並び替えることです。
ついでに名前の50音順で並び換わるようにもしています。

○ソース
この間のソースを一気に流して「うーん？」ってなったので
今日は途中途中で切りながらいきます。

 

～～～～～～～ソース１．-ここから～～～～～～～～
'==============================================
'学年分け
'==============================================
Sub GakunenWake()
  SheetSet
  DontLook
 
[1]
  WH4.Cells.Delete

[2]
  'ウィンドウ枠の解除
  ActiveWindow.FreezePanes = False
 
[3]
  i = 2
  LG = WH1.Range("A65536").End(xlUp).Row
  CNT1 = WorksheetFunction.CountIf(WH1.Range("F1:F" & LG), "1")
  ReDim Gakunen1(CNT1)
  CNT2 = WorksheetFunction.CountIf(WH1.Range("F1:F" & LG), "2")
  ReDim Gakunen2(CNT2)
  CNT3 = WorksheetFunction.CountIf(WH1.Range("F1:F" & LG), "3")
  ReDim Gakunen3(CNT3)
 
[4] 
  j = 0  '1年用
  k = 0  '2年目
  l = 0  '3年目
  Do Until i > LG
    If WH1.Range("F" & i).Value = "1" Then
      Gakunen1(j) = WH1.Range("A" & i).Value
      j = j + 1
    End If
    If WH1.Range("F" & i).Value = "2" Then
      Gakunen2(k) = WH1.Range("A" & i).Value
      k = k + 1
    End If
    If WH1.Range("F" & i).Value = "3" Then
      Gakunen3(l) = WH1.Range("A" & i).Value
      l = l + 1
    End If
    i = i + 1
  Loop
 
[5]
  '==========項目名等の編集================
  WH4.Range("A1").Value = "１年生"
  WH4.Range("A1:D1").MergeCells = True
 
  WH4.Range("E1").Value = "２年生"
  WH4.Range("E1:H1").MergeCells = True
 
  WH4.Range("I1").Value = "３年生"
  WH4.Range("I1:L1").MergeCells = True
 
  WH4.Range("A2,E2,I2").Value = "名前"
  WH4.Range("B2,F2,J2").Value = "よみ"
  WH4.Range("C2,G2,K2").Value = "性別"
  WH4.Range("D2,H2,L2").Value = "学校"
 
  WH4.Range("A1:L2").HorizontalAlignment = xlHAlignCenter
  WH4.Range("A2:L2").Borders(xlEdgeBottom).LineStyle = xlDouble
  '=========================================

～～～～～～～ソース１．-ここまで～～～～～～～～

ソース１でやっていること→初期動作
[1]シートのクリア（中身のデリート）
[2]ウィンドウ枠の解除
[3]１年、２年、３年の人数をカウントし変数Gakunen1,2,3を再宣言
[4]学年に合った配列の変数に通し番号を入れていく
[5]項目名の入力

　「　WH4.Range("E1:H1").MergeCells = True　」
　
　見直したら解説してなかったので……「MergeCells」はセルの結合です。
　
　「　Range("結合したいセル").MergeCells = True　」

　ちなみに解除するのはこれを「True」を「False」にするだけです。

 
  ～～～～～～～ソース２．-ここから～～～～～～～～
[1]
 j = 0  'Gakunen1を回す用
  h = 3  'WH4（学年別）に入れる用
  i = 2  'WH1（学生一覧）を回す用
  Do Until j > CNT1
    Do Until i > LG
      If Gakunen1(j) = WH1.Range("A" & i).Value Then
        WH4.Range("A" & h).Value = WH1.Range("B" & i).Value
        WH4.Range("B" & h).Value = WH1.Range("C" & i).Value
        WH4.Range("C" & h).Value = WH1.Range("D" & i).Value
        WH4.Range("D" & h).Value = WH1.Range("E" & i).Value
        h = h + 1
        Exit Do
      End If
      i = i + 1
    Loop
    i = 2
    j = j + 1
  Loop
  WH4.Select
  WH4.Range("A3:D" & CNT1 + 2).Sort Key1:=Range("B3"), order1:=xlAscending
   

 [2]  
  k = 0  'Gakunen2を回す用
  h = 3  'WH4（学年別）に入れる用
  i = 2  'WH1（学生一覧）を回す用
  Do Until k > CNT2
    Do Until i > LG
      If Gakunen2(k) = WH1.Range("A" & i).Value Then
        WH4.Range("E" & h).Value = WH1.Range("B" & i).Value
        WH4.Range("F" & h).Value = WH1.Range("C" & i).Value
        WH4.Range("G" & h).Value = WH1.Range("D" & i).Value
        WH4.Range("H" & h).Value = WH1.Range("E" & i).Value
        h = h + 1
        Exit Do
      End If
      i = i + 1
    Loop
    i = 2
    k = k + 1
  Loop
  WH4.Select
  WH4.Range("E3:H" & CNT2 + 2).Sort Key1:=Range("F3"), order1:=xlAscending
   

[3]   
  l = 0  'Gakunen3を回す用
  h = 3  'WH4（学年別）に入れる用
  i = 2  'WH1（学生一覧）を回す用
  Do Until l > CNT3
    Do Until i > LG
      If Gakunen3(l) = WH1.Range("A" & i).Value Then
        WH4.Range("I" & h).Value = WH1.Range("B" & i).Value
        WH4.Range("J" & h).Value = WH1.Range("C" & i).Value
        WH4.Range("K" & h).Value = WH1.Range("D" & i).Value
        WH4.Range("L" & h).Value = WH1.Range("E" & i).Value
        h = h + 1
        Exit Do
      End If
      i = i + 1
    Loop
    i = 2
    l = l + 1
  Loop
  WH4.Select
  WH4.Range("I3:L" & CNT3 + 2).Sort Key1:=Range("J3"), order1:=xlAscending
 ～～～～～～～ソース２．-ここまで～～～～～～～～

ソース２でやってること→シート「学年別」に各学年ごとに格納
[1][2][3]
実はやってること全部同じ。
変数ｌをCNT1,2,3の数まで回して、変数Gakunen1,2,3に入っている
通し番号と学生一覧を比較します。

そして一致したものを引っ張ってきて学年別の各列に格納してます。
１年→A:D列
２年→E:H列
３年→I:L列

で、最後に各学年を名前ごとにソート。

「　WH4.Range("I3:L" & CNT3 + 2).Sort Key1:=Range("J3"), order1:=xlAscending　」

書き方はこうですね。

「　Range(並べ替えたい範囲).Sort (←半角スペース)
　　Key1:=Range(並び替えのキー),
　　order1:=xlAscending(昇順。降順→xlDescending)　」

ちなみにソートのキーは3つまで使えます。
これ以上やりたい場合は、2回3回に分けましょう。
その時は優先度の低いキーを先にすると望んだ通りに並び変わるはずです。
……間違えてたらごめんなさい←

  
 
 ～～～～～～～ソース３．-ここから～～～～～～～～
[1]
  '列幅のオートフィット
  LR = WH4.UsedRange.Columns.Count
  For i = 1 To LR
    WH4.Rows(i).EntireColumn.AutoFit
  Next
 
[2]
  '罫線
  LG = WH4.UsedRange.Rows.Count
  WH4.Range("D1:D" & LG).Borders(xlEdgeRight).Weight = xlMedium
  WH4.Range("H1:H" & LG).Borders(xlEdgeRight).Weight = xlMedium
  WH4.Range("L1:L" & LG).Borders(xlEdgeRight).Weight = xlMedium

[3] 
  'ウィンドウ枠の固定
  WH4.Range("3:3").Select
  ActiveWindow.FreezePanes = True
 
 
  WH4.Range("A1").Select
  OKLook

～～～～～～～ソース３-ここまで～～～～～～～～

ソース３でやってること→最終処理
[1]列幅のオートフィット
　最初の処理で前回の列幅も消えているので調整します。
　最初から列幅を指定するよりも最後に自動調整しているので、
　まあ、間違いはないかと。

[2]罫線を引く
　変数LGに使っている行数を格納。
　そして、1行目からLG行までの学年の境に中太線を引きます。

[3]ウィンドウ枠の固定
　今回は1行目に学年、2行目に項目名が入ってるので3行目以降が
　動くようにします。
　ちなみに行選択の場合ウィンドウ枠の固定は選ばれた行から上が
　固定されます。
　一回適当にやってみると覚えやすいかもですね！

 

ではでは、本日はここまでです。

※ちょっとした小技※
……ってほどでもないですけど、Excel画面で「Alt+F11」で
簡単にVBAの画面が出てきます。
いちいちボタン押したりするのが面倒な方や興味のある方は
試してみるといいかもしれません

 

こんばんは若槻です。久しぶりにいつもと違う目薬を買ってきました。
清涼度が強いですが大丈夫でしょうか（・ｖ・；）｛どきどき

今日はVBAの方はお休みします。ちょっと時間がないですの……。
あ、それでもひとつだけ追加報告しますと、検索の動作が
完成しました。

明日からまた別のものを作りますが、どなたか「こういうの作ってみたら？」っていう
ネタがあったら教えてくださいor提案してやってください！
自分で考えるといまいち幅が足りなくなってくるので……（－ω－；）


さて本題。
2月に入ったのでサイトのトップを変更しました。
本当は季節に合ったイラストでも、と思っていたのですが、
何を思ってかフラッシュで作品紹介することにしました。

ブログ脇のすぴばるのつぶやきにURLが貼ってあるので
よければご覧くださいまし。
そしてあわよくば本編を……っ！

妙な出来だけど気にしちゃいけない←



以下拍手返信です。

皆さんこんばんは若槻です。
金曜日に「もう駄目だーーーっっ」とか騒いでいたＱＲコード問題は
無事に解決されました。

午前中丸々と言えるほどそばで付き合ってくれた課長。
何度も見に来ていろいろ考えたり解決策をネットで探ってくれた先輩。
そして解決の方法を見つけて教えてくれた同期。
みなさん本当にありがとうございましたー!!!!


さて、では昨日の続きで本日もＶＢＡのおしゃべりです。
今日も隠しませんので悪しからずｏ（＿　＿）ｏ


====================================================
◎システム名　「演習-学生名簿」
====================================================

～現在ある内容～
・グループ分け
・学年別　　←簡単１
・学校別
・性別ごと　←簡単２
・配役配置
・試合
・検索（作成中


システムを作成した順としては上から流れる感じなんですが、
今日は簡単なところから行くとして「性別ごと」について語ろうかと
思います。

ツールバーはいつ語ろうか……。
どなたか（いないかな？　いてもきりちゃんでしょうか）、
「早く文字ツールバーのやり方知りたい」って思ったら連絡くださいな。
若槻も語りたいのでいつでも行きますｗ
※文字ツールバー＝こんなの↓





では、はじめましょうか。


１．ワークシート
とりあえず前提と言うことで語っておきます。

○項目
このシステムの大元になるのがシート「学生一覧」に格納されている
学生のデータです。
ちなみに若槻の場合は適当に作った面々とネットから拾ってきた
キャラクターの名前が入っています。

その項目がこちら。





[1]通し番号　　←そのまま。ただし名前が入ったら自動で入るようにしている
[2]名前　　　←そのまま
[3]よみ　　　←これがないと出来ないことも多い
[4]性別　　　←遊び心を出すためのお友達
[5]学校名　　←同上
[6]学年　　　←同上
[7]所属グループ　　←「グループ分け」の時に入る


○ワークシートに変更があった時
「マクロ」やら「プロシージャ」やら言うと標準モジュールに書くのが
まあ一番よくあるパターンでしょうか。
けど、実はワークシート自体にもワークブック自体にもそれらに
関するプロシージャが最初から用意されています。

今回で言うなら「通し番号」の項目がそれですね。
これは「ワークシートに変更があったら」というマクロを組んでいます。

それがこちら。

Private Sub Worksheet_Change(ByVal Target As Range)
  LG = Range("B65536").End(xlUp).Row
  If Range("B" & LG).Value <> "" Then
    Range("A" & LG).Value = Range("A" & LG - 1).Value + 1
  End If
End Sub

上から何をしているのかを言っていくと、

「　LG = Range("B65536").End(xlUp).Row　」

これは変数LG（Long型）に最終行の格納をしています。
最終行や最終列を取る時は上からや左から取る方法も
もちろんありますが、途中で空白行があった時に「んん？」と
なるので下から・右から取ってきた方がいいですね。

シート名．Range（"最終行を取りたい列＋Excelの最終行"）．
　　　　　　End（どの方向に行くか）．Row

でももっと早く取りたい人はこっちの方がいいかもですね。

  LG = WH3.UsedRange.Rows.Count

これは「使ったセル」を見つけてくるっていうもの。
ちなみに若槻は列見つけてくる時にしか使わないです。
え？　何でって？　単なる慣れの問題ですｗ

列のときはこうですね。

  LG = WH3.UsedRange.Columns.Count

さてずれましたが続けましょう。
次はこれですね。

  If Range("B" & LG).Value <> "" Then
    Range("A" & LG).Value = Range("A" & LG - 1).Value + 1
  End If

今回の場合はB列、つまり名前列に何か入力されたらA列に
ひとつ上の番号に１を足した値を入れる、というものなので

「B列の最終行に値が入った場合A列の最終行のセルに
　その上のセルの値に１を足した値を入れる｣

ということをやっています。



１．性別ごと
では本日の本題にいきますか。
星の着いた抜き出し部分の解説は下でやりますから、
これは読み飛ばしても大丈夫です。

～～～～～～～ソース～～～～～～～～
'==============================================
'性別分け
'==============================================
Sub SeibetuWake()
  DontLook
  SheetSet
  
  WH6.Cells.Delete----☆

  'ウィンドウ枠の解除
  WH6.Select
  ActiveWindow.FreezePanes = False-------☆
 
 
  '====================項目設定=====================
  WH6.Range("A1").Value = "男"
  WH6.Range("A1:D1").MergeCells = True
  WH6.Range("E1").Value = "女"
  WH6.Range("E1:H1").MergeCells = True
 
  WH6.Range("A2,E2").Value = "名前"
  WH6.Range("B2,F2").Value = "よみ"
  WH6.Range("C2,G2").Value = "学校"
  WH6.Range("D2,H2").Value = "学年"
  
  WH6.Range("A1:H2").Font.Bold = True-------☆
  WH6.Range("A1:H2").HorizontalAlignment = xlCenter-------☆
  WH6.Range("A1:H1").Borders(xlEdgeBottom).LineStyle = xlContinuous
　-------☆　
  WH6.Range("A2:H2").Borders(xlEdgeBottom).LineStyle = xlDouble
　-------☆
  '=================================================
 
  '男女の数を数える
  LG = WH1.Range("A65536").End(xlUp).Row
  CNT1 = WorksheetFunction.CountIf(WH1.Range("D1:D" & LG), "男")
　-------☆
  ReDim Boys(CNT1)-------☆
  CNT2 = WorksheetFunction.CountIf(WH1.Range("D1:D" & LG), "女")
  ReDim Girls(CNT2)
 
  '男女ごとに変数に格納していく
  j = 0  '男子用
  k = 0  '女子用
  i = 2  'WH1用
  Do Until i > LG
    If WH1.Range("D" & i).Value = "男" Then
      Boys(j) = WH1.Range("A" & i).Value
      j = j + 1
    End If
    If WH1.Range("D" & i).Value = "女" Then
      Girls(k) = WH1.Range("A" & i).Value
      k = k + 1
    End If
    i = i + 1
  Loop
 
  '実動作
  j = 0  'Boysを回す用
  h = 3  'WH6（性別）に入れる用
  i = 2  'WH1（学生一覧）を回す用
  Do Until j > CNT1
    Do Until i > LG
      If Boys(j) = WH1.Range("A" & i).Value Then
        WH6.Range("A" & h).Value = WH1.Range("B" & i).Value
        WH6.Range("B" & h).Value = WH1.Range("C" & i).Value
        WH6.Range("C" & h).Value = WH1.Range("E" & i).Value
        WH6.Range("D" & h).Value = WH1.Range("F" & i).Value
        h = h + 1
        Exit Do
      End If
      i = i + 1
    Loop
    i = 2
    j = j + 1
  Loop
  WH6.Range("A3:D" & CNT1 + 2).Sort _
            Key1:=Range("D3"), order1:=xlDescending, _
            Key2:=Range("B3"), order2:=xlAscending, _
            Key3:=Range("C3"), order3:=xlAscending
 
 
  k = 0  'Girlsを回す用
  h = 3  'WH6（性別）に入れる用
  i = 2  'WH1（学生一覧）を回す用
  Do Until k > CNT2
    Do Until i > LG
      If Girls(k) = WH1.Range("A" & i).Value Then
        WH6.Range("E" & h).Value = WH1.Range("B" & i).Value
        WH6.Range("F" & h).Value = WH1.Range("C" & i).Value
        WH6.Range("G" & h).Value = WH1.Range("E" & i).Value
        WH6.Range("H" & h).Value = WH1.Range("F" & i).Value
        h = h + 1
        Exit Do
      End If
      i = i + 1
    Loop
    i = 2
    k = k + 1
  Loop
  WH6.Range("E3:H" & CNT2 + 2).Sort _
            Key1:=Range("H3"), order1:=xlDescending, _
            Key2:=Range("F3"), order2:=xlAscending, _
            Key3:=Range("G3"), order3:=xlAscending
 
 
 
  '列幅のオートフィット
  LR = WH6.UsedRange.Columns.Count
  For i = 1 To LR
    WH6.Rows(i).EntireColumn.AutoFit-------☆
  Next
 
  '罫線
  LG = WH6.UsedRange.Rows.Count
  WH6.Range("D1:D" & LG).Borders(xlEdgeRight).LineStyle = xlDouble
  WH6.Range("H1:H" & LG).Borders(xlEdgeRight).Weight = xlMedium
 
  'ウィンドウ枠の固定
  WH6.Range("3:3").Select-------☆
  ActiveWindow.FreezePanes = True-------☆
 
 
  WH6.Range("A1").Select
  OKLook
End Sub

～～～～～～～～～～ソース－ここまで～～～～～～～～～～～～～

○セルのデリート
これはそのままですね。

「  WH6.Cells.Delete　」

で、WH6のセルを全てデリートしています。
列幅や業の高さなどにこだわらない時などには使うといいかと。

○ウィンドウの固定と解除
ウィンドウを固定したい、ということはExcelを使う人なら
大なり小なり思うことではないでしょうか。
たとえばデータ数が多いときなどに、項目名がいつでも出るように
したい、とか。

そんなときに便利なのがこれですね。

  'ウィンドウ枠の固定
  WH6.Range("3:3").Select　　←固定したい行や列を選択
  ActiveWindow.FreezePanes = True

で、逆に解放するのがこれです。

　'ウィンドウ枠の解除
  WH6.Select　　←シートを選択
  ActiveWindow.FreezePanes = False

○太字
「項目名とかに太字を使いたい」って言う時にでも。

「 WH6.Range("A1:H2").Font.Bold = True　」

これを「False」にすると太字は解除されます。
斜体文字も同じ感じですね。

○中央寄せ
文字の中央寄せです。

「　WH6.Range("A1:H2").HorizontalAlignment = xlCenter　」

この「xlCenter」の所は実はもうちょっと長い書き方の
はずなんですが、バグなのかなんなのかこれでもいけたので
これで行ってます。

ちゃんとやりたい方は調べることをお勧めします（コラ

○罫線
罫線は色々ありますけど、とりあえず基本的なものだけ。

「　シート.セル.Borders(引く場所).LineStyle = 線の種類　」
「　シート.セル.Borders(引く場所).Weight = 線の太さ」
　
（Ex）
「 WH6.Range("D1:D" & LG).Borders(xlEdgeRight).LineStyle = xlDouble 」
「 WH6.Range("H1:H" & LG).Borders(xlEdgeRight).Weight = xlMedium 」
「 WH6.Range("A1:H1").Borders(xlEdgeBottom).LineStyle = xlContinuous 」

ちなみにBordersの後ろに何も書かなければ格子状に
罫線が引かれます。
その時にTrueとFalseで使い分けられるのですが、
これはググればすぐに出てくるのでスルーしちゃいます←
あ、線の種類や太さも同様ですのでスルーします＾＾；

○Excelで使える関数を使うために
実はVBAではExcelで使える関数が使えないことがあります。
RoundとかCountとか。

それでも使いたい！　って時がたまにあると思います。

そんな時にはこういう使い方。

「  CNT1 = WorksheetFunction.CountIf(WH1.Range("D1:D" & LG), "男")　」

「WorksheetFunction」をつけることでExcel上の関数が使えるように
なります。
色々あるので、これは実際やってみた方が面白いですよ！

○再宣言
……に、使うのがこれ

「　ReDim Boys(CNT1)　」

配列を使うときなどで、最大数が最初は分からないときなどに有効です。
最初に

Dim　変数()　as　△△

と決めておき、いくつ入れるか分かった場合に上記の通りに
書きます。上で言う「CNT1」にはそれぞれが数を出すために
使った変数が入るのが大体かなーと思います。

あ、この時に使った変数の値を取っておくと、たとえば後で
その配列を回したいときに

Do Until I > CNT1　
（作業）
Loop

とかに使えますよ。Forでもいいし。

○列幅のオートフィット
意外に使うことがあるのがこれ。
いったん全てのセルなどを削除してからデータを入れた後などに
データの中身ごとに列幅を変える、など。

書き方はこうです。

  LR = WH6.UsedRange.Columns.Count
  For i = 1 To LR
    WH6.Rows(i).EntireColumn.AutoFit
  Next

変数LRに使った列のカウントを入れて、Forで終わるまで回し、
その間にシートの１からLR列目の幅を一列ずつ変えていきます。

※注意※
列幅や行の高さ、罫線などは1列ごと・1行ごとに命令を実行しないと
面白いことになりかねません。
気になる方は一度やってみましょう（笑）

 

さて、これで性別ごとは終わりです。
ぶっちゃけ今更このプログラム見るとちょっと手間がかかってるので
別のプログラムのやり方取り入れればもっと早いんですが、
いまさら書き直す気力も無いのでこのまま晒しますｗ

では本日はこの辺りで。
残りはまた後日にでもノ

 

こんばんは若槻です。本日は来月のTOPに使うためのものを
仕上げていました。見直すと「うん；？」となるところがありますが
作り直す気力は無いのでこのままいきます←

さて、本日はおとといくらいに延期になったVBAについて
語ってみようと思います。
※量が多いので数日に分けます

興味ない人もいるかもしれませんが隠しません。
ではスタート～。


====================================================
◎システム名　「演習-学生名簿」
====================================================

今回のシステムはシートに登録された（シート内にずらっと名前やら
学校名やら学年が並んでるだけ）学生たちを使って色々する、というものです。

～現在ある内容～
・グループ分け
・学年別　　←簡単１
・学校別
・性別ごと　←簡単２
・配役配置
・試合
・検索（作成中


分けられたもの見ても面白くないでしょうから中身を
解説してみます。
→ちなみに「解説」とか偉そうなこと言ってますが、
　若槻もひよっこなので、あくまで若槻のプログラムです。
　何か作りたい方はネットでちゃんとしたVBAサイトを
　探した方が身のためです（おい　


まずは簡単なところから。

０．基本（諸動作)
○ワークシート
ExcelのVBAでワークシートやらワークブックやらを指定する時は

「　Worksheets("シート名")　」（ブックの時はWorkbooks

とかって書かなくちゃいけません。
でもこれ毎回やってたら面倒だし、万一シート名を変更した時に
いちいち直しに行くのが非常に面倒。
なので、若槻は変数を決めてそこにセットしています。

「　Public WH1 As Worksheet　」

こう書くと「Publicである必要は？」と言われそうですが、
若槻は変数を全て１つの標準モジュールにまとめてるので
これがデフォです←

とにかくWH1という変数をWorksheet型で定義します。
そして別のところで

「　Set WH1 = Worksheets("シート名")　」

とします。これでどのプロシージャ（Sub～End Subに挟まれた作業）でも
WH1でシートを指定できます。
こうしておくとシート名を変えても上の文をひとつ変えるだけで済みます。

あ、ただ一箇所だけに済ませるには上のセット文をひとつの
プロシージャにしておく必要がありますけどね。
これはそれ専用の作るのが良いと思います。
別のプログラムでも使えますし。
こんな感じで（プロシージャ名は自由にどうぞ。日本語もおｋ）↓

Sub SheetSet()
  Set WH1 = Worksheets("シート名")
End Sub

こうしておけばたとえば

Sub AAA ()
　　SheetSet（←これで呼び出し
　　WH1.Range("A1").Value =　"ｈｈｈ"
End Sub

てな感じでいけます。ちなみにこうした場合は必ず最初に
SheetSetを呼び出さないと「そんなの知らん」って怒られます。



○描写の停止等々
さてマクロを実行する時にそのまま実行させると画面が高速で
変わっていきます。これは平気な人は放っておいていいと思いますが
正直目に来ますよね。

そんな貴方にお勧めはこちら（通販か
プロシージャの

Sub DontLook()
  '画面の移動を見せない
  Application.ScreenUpdating = False
  '確認メッセージを出さない
  Application.DisplayAlerts = False
  'マクロの動作が起因するイベント発生を抑制
  Application.EnableEvents = False
End Sub

このマクロを入れておくだけで画像のちらつきがなくなります。
ちなみにこの反対はこちら

Sub OKLook()
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
  Application.EnableEvents = True
End Sub

最後に見えるようにしておきましょう。やらなくても問題ないことの方が
多いですがやっておいた方が心配はないかと。
書き方はこんな感じですかね。

Sub BBB ()
　　DontLook
　　（作業）
　　OKLook
End Sub

これでひとまとまり。
※下手にオープン時の処理の時とかに使うと挙動がおかしくなるので
　ご注意ください。

○オープン時とクローズ時に作業
せっかく「オープン時」とか言ったのでそれについても触れてみます。
流れなんて気にしない。

オープン時、というのは、Excelを開いた時のことです。
たとえば「Excelを開いたらこのシートをクリアしたい」とかが
あった時に使います。
書き方はこう。

Sub auto_open()
  （作業）
End Sub


で、クローズ時はその逆でExcelを閉じた時のことです。
たとえば「このExcelを自動的に保存したい」など。
書き方はこうなります。

Sub auto_close()
  （作業）
End Sub

※注意※
他のプロシージャと違って開閉時のプログラムの名前は必ず
「Auto_Open」と「Auto_Close」にしましょう。
これはこう書くと自動的に開閉時の処理として認識されるからです。
他の書き方もあるかもしれませんが若槻は知らないので
「こう書きましょう」と言いきります。


○保存
一応書いておきましょう。一番楽なのはこうですね。

「　ThisWorkbook.Save　」

ぶっちゃけ名前指定するとブック名変えた時とかコピーの方を
触った時に面倒なんです。



……ふむ。長くなってきたので今日はこの辺りにします。
また後日システム内のお話とツールバーについてを
お話したいと思います。

特にツールバーは文字表示の方法を語りたい！
だってググってもアイコンVerしか出てこないですよ（調べ方が悪いとか言わないｗ）
なのでここで語りたい頑張って見つけ出したやり方をｗ！

ではまた後日ノノ
VBA知らない人にはあまりに退屈な記事でしたかねー（´∀｀；）

こんばんは若槻です。買い物に行くために車に乗り込んだら運転中に
目やら頭やらが辛くなりました。えぇー……（・д・；）


さて、今日はそんな思いをしながら昨日行くつもりだった外付けＨＤＤの
お買い物に行ってきました。

電気屋の広告を見て「これにしよう」と決めて行ったのですが、買ったのは
それよりもいくらか高いもの。しかしなかったわけではないのです。
いざ現物を目にすると、値段こそ高くなっていますが通常の値段の
約半分の値段になっている上に性能が段違いにいいという代物を
見つけてしまったのです！

これは買うしかないと即決。
さらにＤＶＤ－ＲとＵＳＢメモリを購入。これで1万ちょいという値段。
いい買い物ですｖｖ

でもちょっとあちゃーだったのは、家に使ってないＵＳＢが残っていたのを
忘れていたことですね。いつも買ってきたＵＳＢを置くところに置いたら
すでに有ってびっくりしました（笑）
まあいいですが。どうせ使いますし←


というわけで新たな保存先を見つけたおかげで久しぶりに
バックアップがスムーズでした。
よかったよかった＾＾


続きに拍手返信格納です。
名もなき方々もありがとうございました♪