趣味のエクセルマクロ

ナンバーズ4などの数字選択式宝くじデータ分析用の自作マクロおよびナンバーズ4の各種データリストなどをブログにしています。

マクロ 対話型

 MsgBox


マクロを起動させた時に、処理を質問表示させる様にします。
ここでは、はい(Y)で実行、いいえ(N)で何もせずに終了します。
(はい(Y)で最初から最後のデータまで処理しています。)


●印表示処理に時間がかかるので、実行するか確認のために「開始しますか?」を
表示させ、下のボタン選択押下します。(4000行を超えるデータで時間がかかるw)



Sub patapata_3()  '当選数字パターン貼付け


Dim i, j, dai, lastkai As Integer
Dim daida As String


 Sheets("原本").Select
 lastkai = Cells(1, 12) + 3
 
    start = MsgBox("開始しますか?", vbYesNo)
 If start = vbNo Then End 
’もし、いいえならマクロ終了


saikeisanoff
 Range("by3:cj5000").ClearContents
_
_
_
End Sub


-------------------------------------------------------------------------------------------------


InputBox



マクロ起動で入力をうながします。
入力し「OK」ボタン押下で検索処理をします。


Sub box_kensaku() ' 検索して入力
Dim bango As String


  On Error GoTo errorcheck
Sheets("box").Select
  Range("B3:W65").Select
   bango = InputBox("box番号入力して下さい", Default:=Cells(1, 25))
  
   If Len(bango) <> 4 Then MsgBox ("4桁で番号入力してください。"): End
  
   Cells(1, 25) = bango
’ 入力したbangoを検索する
    Selection.Find(What:=bango, After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, MatchByte:=False, SearchFormat:=False).Activate


 _
 _
 _
End Sub


両方を組み合わせて処理しています。InputBox → MsgBox




Office TANAKA さんのサイトには詳しい説明が載っていました。
私も勉強したいと思います。


マクロの中でワークシート関数を使う

マクロの中で関数を使うと便利ですね。全部の関数が使える様ではないですが?
私も出来るだけ使っています。


・文字列関数や日付関数はマクロの中で使えない様です。


 



 Cells(i, 84) = WorksheetFunction.CountIf(Range(Cells(2, 83), Cells(i, 83)), Cells(i, 83))

最初の行CE2のCells(2, 83)から現在の行Cells(i, 83)までCells(i, 83)のデータが何回か計算して隣のCF列、Cells(i, 84)に合計として出してる。
(この計算では時間が掛かり過ぎるかも知れませんが? 行iは2~現在行まで変化する)



私のマクロではApplicationを使っていますが今はWorksheetFunctionですね。






 caunter = Application.CountA(Range(Cells(4500, writretu), Cells(5500, writretu)))
上の式で、上の表のデータ個数をカウント(赤字)している。これも元に次のデータ記入位置(上の行に向かって)を計算(カウントが3の場合、次のカウントは4なので次回は1行上にデータを出力)



---------------------- 他の使い方 例 ---------------------------
Cells(5501, 320) = 5501 - Application.Max(Range(Cells(5501, 200), Cells(5501, 319)))
5501行の200列から319列での最大値を出して5501から引き算して320列5501行に出力




 
データを参照し、回号分を関数コピーしさらに値コピーする。
Sub kankaku_sita_syuukei()   ' 間隔を下並びで出力。整列コピーする準備

 kaigo = Range("l1") ’最終回号とする。
 
    Range("gi10") = "=CL3 " 'データを参照する(gi10に =CL3 の式を入れる)
    Range("gj10") = "=CN3 "
    Range("gk10") = "=DG3 "
    Range("gl10") = "=DA3 "
    Range("gm10") = "=DB3 "
    Range("gi10:gm10").Copy Range(Cells(11, 191), Cells(9 + kaigo, 195)) 'データを回号分コピー
   
     Range(Cells(11, 191), Cells(9 + kaigo, 195)).Select ’値コピー(関数を消す)
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


 ---
 ---
End  Sub 



コメント追加マクロ

メニューからのコメント追加が面倒になりました。

ネット情報からコメント追加マクロを見つけましたので私なりに改造しました。
やはりコメントつけるのが楽になりますね。




'コメントの追加をする。(セルは一度に1つのみ,既にコメントある場合エラーになる


Sub AddComment()
    Dim cmt As Comment      ' 追加するコメントのオブジェクト変数
    Dim gyou, retu As Integer 'コメント追加行と追加列の整数変数
    Dim moji As String 'コメント内容の文字変数(数字も文字として扱う)
   
     gyou = ActiveCell.Row ’行位置を変数に格納する
     retu = ActiveCell.Column列位置を変数に格納する

       ' moji = InputBox("回号入力")’コメントの回号入力する(ここでは2858--2863)
        moji = Application.InputBox("回号入力")
        If moji = False Then End 'コメント入れずに終了する
        '(上の式でエラー出ました、今は使わないようにしてます)

 ’コメントのオブジェクト変数にコメントを入れる( cmt←moji )
    Set cmt = Cells(gyou, retu).AddComment(Text:=moji)


    'gyou,retuを使わない時は下の様でも良いです。
    Set cmt = ActiveCell.AddComment(Text:=moji)

   
     cmt.Shape.TextFrame.AutoSize = True 'コメントサイズの自動調整(長方形)
        ' 文字列の形式設定
    With cmt.Shape.TextFrame.Characters.Font
        .Name = "MS ゴシック"
        .FontStyle = "標準"
        .Size = 9
       .Bold = True’太字
     End With

End Sub


----------------------------------------------------


’コメント削除(単一セルの場合)
’ cmt.Comment.Delete


Sub DelComment()
    Dim cmt As Comment      ' コメントのオブジェクト変数
    Dim gyou, retu  As Integer 'コメント削除行と削除列
     Dim start As Integer   '処理選択用

     gyou = ActiveCell.Row
     retu = ActiveCell.Column

          start = MsgBox("コメントを削除しますか?", vbYesNo)
          If start = vbNo Then End

    Set cmt = Cells(gyou, retu).Comment
    'gyou,retuを使わない時は下の様でも良いです。
    Set cmt = ActiveCell.Comment

    cmt.Delete 'コメントを削除する


End Sub
-------------------------------------------------------
’コメント削除(複数セルの場合)
’  hanni.ClearComments


Sub clearlComment()
  
   Dim hanni As Range ’複数セル範囲用
     Dim start As Integer   '処理選択用
    

           start = MsgBox("複数のコメントを削除しますか?", vbYesNo)
          If start = vbNo Then End
      
          Set hanni = Selection
       
     hanni.ClearComments '複数セルのコメントを削除する


End Sub