[[20050617095647]]　『VBAについて』（よねさん）　ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

　

『VBAについて』（よねさん）

こんにちは。
マクロで、インプット画面から、新規で作成したシートがあります。
また、別に「データ」というシートがあります。そのシートのデータは、追加してきたシート毎のデータの内容の一部を取ってきて、表になっています。

やりたいことは、新規で作成したシートから、データシートの表に新規シートのデータをとりたいのです。新規で作成したシートのシート名のの選択の仕方を教えていただきたいです。

よろしくお願いいたします。

---

 標準モジュールへ
Public NewWs As Worksheet
　
ブックモジュールへ
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Set NewWs = Sh
End Sub
　
名前の取得は
NewWs.Name
　
追加した一番新しいシートであれば、途中で名前が変更されても
有効。変数名NewWsは任意。（みやほりん）

---

 別案で、
Sheet名を指定して追加する。。なんちゃって
Sub てすと()
Sheets.Add.Name = "Sheet" & Worksheets.Count + 1
End Sub
（SoulMan）

---

 補足です。
＞インプット画面から、新規で作成したシートがあります。
とあるので、InputBox関数（メソッド）でシート名を指定しているのでは、と推測も。
だとしたら取得はできているのですが。
また、私の方法はあくまで「新規シート挿入」に対してのものなので、
既存のシートをコピーするものには不適。
#今日はこれで終わりなので、書き逃げ（みやほりん）

結局、インプット画面をまた表示させて、その値で集計するようにしました。
PGはこんなかんじです。
（みやほりん）のやり方を何度も試したのですが、どうしてもわからなくて、
簡単な方ににげてしまいました。
また、教えてください（M＿　＿M）

  Dim i      As Integer    '整数型の変数：セルが初期セルよりどれだけ右のセルを指定しているかをもっておく領域
  Dim str    As String   '指定した文字列を格納する領域
  Dim cell   As Range   'シートのセルを格納する領域

  Dim 表 As Range

  Dim Message, Title, Default, MyValue

    Message = "集計するシート名を入力してください。"    ' 入力を求めるメッセージを設定します。
    Title = "集計"                        ' タイトルを設定します。
    Default = ""                                    ' 既定値を設定します。

     'メッセージ､タイトル､既定値を表示します｡
    MyValue = InputBox(Message, Title, Default)

    If Len(MyValue) > 0 Then

        Set 表 = ActiveCell.CurrentRegion

        With 表.Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With

        表.BorderAround xlContinuous, xlThick

    '初期のセルをセット                          ↓一番はじめにチェックするセルを指定する。
     Set cell = Range("D1")
                      '↑ここに取得したシート名を入れる。

    '初期化
    i = 0

    '初期セルから右に何番目が空白かを調べる。

    '↓初期セルより下に0個、右にi個移動したセルの値が空白になるまでiを1づつ足していく
    Do Until cell.Offset(0, i).Value = ""
        i = i + 1
    Loop

    MsgBox "空白セルは右に" & i & "番目です。"

    '障害
    Selection.Value = i + 1
    'シート名取得
    ActiveCell.Offset(1, 0) = Mid(cell("filename"), Find("[", cell("filename")) + 1, Find("]", cell("filename")) - Find("[", cell("filename")) - 1)

    ActiveCell.Offset(2, 0) = Null
    ActiveCell.Offset(3, 0) = Worksheets(MyValue).Range("C5").Value
    ActiveCell.Offset(4, 0) = Worksheets(MyValue).Range("C6").Value
    ActiveCell.Offset(5, 0) = Worksheets(MyValue).Range("C7").Value
    ActiveCell.Offset(6, 0) = Worksheets(MyValue).Range("C8").Value
    ActiveCell.Offset(7, 0) = Worksheets(MyValue).Range("C9").Value
    ActiveCell.Offset(8, 0) = Worksheets(MyValue).Range("C10").Value
    ActiveCell.Offset(9, 0) = Worksheets(MyValue).Range("C11").Value
    ActiveCell.Offset(10, 0) = Worksheets(MyValue).Range("C12").Value
    ActiveCell.Offset(11, 0) = Worksheets(MyValue).Range("C13").Value
    ActiveCell.Offset(12, 0) = Worksheets(MyValue).Range("C14").Value
    ActiveCell.Offset(13, 0) = Worksheets(MyValue).Range("C15").Value
    ActiveCell.Offset(14, 0) = Worksheets(MyValue).Range("C16").Value
    ActiveCell.Offset(15, 0) = Worksheets(MyValue).Range("C17").Value
    ActiveCell.Offset(16, 0) = Worksheets(MyValue).Range("C18").Value
    ActiveCell.Offset(17, 0) = Worksheets(MyValue).Range("C19").Value
    ActiveCell.Offset(18, 0) = Worksheets(MyValue).Range("C20").Value
    '完了
    ActiveCell.Offset(19, 0) = Null
    ActiveCell.Offset(20, 0) = Worksheets(MyValue).Range("D5").Value
    ActiveCell.Offset(21, 0) = Worksheets(MyValue).Range("D6").Value
    ActiveCell.Offset(22, 0) = Worksheets(MyValue).Range("D7").Value
    ActiveCell.Offset(23, 0) = Worksheets(MyValue).Range("D8").Value
    ActiveCell.Offset(24, 0) = Worksheets(MyValue).Range("D9").Value
    ActiveCell.Offset(25, 0) = Worksheets(MyValue).Range("D10").Value
    ActiveCell.Offset(26, 0) = Worksheets(MyValue).Range("D11").Value
    ActiveCell.Offset(27, 0) = Worksheets(MyValue).Range("D12").Value
    ActiveCell.Offset(28, 0) = Worksheets(MyValue).Range("D13").Value
    ActiveCell.Offset(29, 0) = Worksheets(MyValue).Range("D14").Value
    ActiveCell.Offset(30, 0) = Worksheets(MyValue).Range("D15").Value
    ActiveCell.Offset(31, 0) = Worksheets(MyValue).Range("D16").Value
    ActiveCell.Offset(32, 0) = Worksheets(MyValue).Range("D17").Value
    ActiveCell.Offset(33, 0) = Worksheets(MyValue).Range("D18").Value
    ActiveCell.Offset(34, 0) = Worksheets(MyValue).Range("D19").Value
    ActiveCell.Offset(35, 0) = Worksheets(MyValue).Range("D20").Value
    '残数
    ActiveCell.Offset(36, 0) = Null
    ActiveCell.Offset(37, 0) = Worksheets(MyValue).Range("E5").Value
    ActiveCell.Offset(38, 0) = Worksheets(MyValue).Range("E6").Value
    ActiveCell.Offset(39, 0) = Worksheets(MyValue).Range("E7").Value
    ActiveCell.Offset(40, 0) = Worksheets(MyValue).Range("E8").Value
    ActiveCell.Offset(41, 0) = Worksheets(MyValue).Range("E9").Value
    ActiveCell.Offset(42, 0) = Worksheets(MyValue).Range("E10").Value
    ActiveCell.Offset(43, 0) = Worksheets(MyValue).Range("E11").Value
    ActiveCell.Offset(44, 0) = Worksheets(MyValue).Range("E12").Value
    ActiveCell.Offset(45, 0) = Worksheets(MyValue).Range("E13").Value
    ActiveCell.Offset(46, 0) = Worksheets(MyValue).Range("E14").Value
    ActiveCell.Offset(47, 0) = Worksheets(MyValue).Range("E15").Value
    ActiveCell.Offset(48, 0) = Worksheets(MyValue).Range("E16").Value
    ActiveCell.Offset(49, 0) = Worksheets(MyValue).Range("E17").Value
    ActiveCell.Offset(50, 0) = Worksheets(MyValue).Range("E18").Value
    ActiveCell.Offset(51, 0) = Worksheets(MyValue).Range("E19").Value
    ActiveCell.Offset(52, 0) = Worksheets(MyValue).Range("E20").Value

    Else
        MsgBox "名称が入力されていません。"
        MyValue = InputBox(Message, Title, Default)

        If Len(MyValue) > 0 Then
            '初期のセルをセット
             Set cell = Range("D1")
                              '↑ここに取得したシート名を入れる。

            '初期化
            i = 0

            '初期セルから右に何番目が空白かを調べる。

            '↓初期セルより下に0個、右にi個移動したセルの値が空白になるまでiを1づつ足していく
            Do Until cell.Offset(0, i).Value = ""
                i = i + 1
            Loop

            MsgBox "空白セルは右に" & i & "番目です。"

            '障害
            Selection.Value = i + 1
            ActiveCell.Offset(1, 0) = Date
            ActiveCell.Offset(2, 0) = Null
            ActiveCell.Offset(3, 0) = Worksheets(MyValue).Range("C5").Value
            ActiveCell.Offset(4, 0) = Worksheets(MyValue).Range("C6").Value
            ActiveCell.Offset(5, 0) = Worksheets(MyValue).Range("C7").Value
            ActiveCell.Offset(6, 0) = Worksheets(MyValue).Range("C8").Value
            ActiveCell.Offset(7, 0) = Worksheets(MyValue).Range("C9").Value
            ActiveCell.Offset(8, 0) = Worksheets(MyValue).Range("C10").Value
            ActiveCell.Offset(9, 0) = Worksheets(MyValue).Range("C11").Value
            ActiveCell.Offset(10, 0) = Worksheets(MyValue).Range("C12").Value
            ActiveCell.Offset(11, 0) = Worksheets(MyValue).Range("C13").Value
            ActiveCell.Offset(12, 0) = Worksheets(MyValue).Range("C14").Value
            ActiveCell.Offset(13, 0) = Worksheets(MyValue).Range("C15").Value
            ActiveCell.Offset(14, 0) = Worksheets(MyValue).Range("C16").Value
            ActiveCell.Offset(15, 0) = Worksheets(MyValue).Range("C17").Value
            ActiveCell.Offset(16, 0) = Worksheets(MyValue).Range("C18").Value
            ActiveCell.Offset(17, 0) = Worksheets(MyValue).Range("C19").Value
            ActiveCell.Offset(18, 0) = Worksheets(MyValue).Range("C20").Value
            '完了
            ActiveCell.Offset(19, 0) = Null
            ActiveCell.Offset(20, 0) = Worksheets(MyValue).Range("D5").Value
            ActiveCell.Offset(21, 0) = Worksheets(MyValue).Range("D6").Value
            ActiveCell.Offset(22, 0) = Worksheets(MyValue).Range("D7").Value
            ActiveCell.Offset(23, 0) = Worksheets(MyValue).Range("D8").Value
            ActiveCell.Offset(24, 0) = Worksheets(MyValue).Range("D9").Value
            ActiveCell.Offset(25, 0) = Worksheets(MyValue).Range("D10").Value
            ActiveCell.Offset(26, 0) = Worksheets(MyValue).Range("D11").Value
            ActiveCell.Offset(27, 0) = Worksheets(MyValue).Range("D12").Value
            ActiveCell.Offset(28, 0) = Worksheets(MyValue).Range("D13").Value
            ActiveCell.Offset(29, 0) = Worksheets(MyValue).Range("D14").Value
            ActiveCell.Offset(30, 0) = Worksheets(MyValue).Range("D15").Value
            ActiveCell.Offset(31, 0) = Worksheets(MyValue).Range("D16").Value
            ActiveCell.Offset(32, 0) = Worksheets(MyValue).Range("D17").Value
            ActiveCell.Offset(33, 0) = Worksheets(MyValue).Range("D18").Value
            ActiveCell.Offset(34, 0) = Worksheets(MyValue).Range("D19").Value
            ActiveCell.Offset(35, 0) = Worksheets(MyValue).Range("D20").Value
            '残数
            ActiveCell.Offset(36, 0) = Null
            ActiveCell.Offset(37, 0) = Worksheets(MyValue).Range("E5").Value
            ActiveCell.Offset(38, 0) = Worksheets(MyValue).Range("E6").Value
            ActiveCell.Offset(39, 0) = Worksheets(MyValue).Range("E7").Value
            ActiveCell.Offset(40, 0) = Worksheets(MyValue).Range("E8").Value
            ActiveCell.Offset(41, 0) = Worksheets(MyValue).Range("E9").Value
            ActiveCell.Offset(42, 0) = Worksheets(MyValue).Range("E10").Value
            ActiveCell.Offset(43, 0) = Worksheets(MyValue).Range("E11").Value
            ActiveCell.Offset(44, 0) = Worksheets(MyValue).Range("E12").Value
            ActiveCell.Offset(45, 0) = Worksheets(MyValue).Range("E13").Value
            ActiveCell.Offset(46, 0) = Worksheets(MyValue).Range("E14").Value
            ActiveCell.Offset(47, 0) = Worksheets(MyValue).Range("E15").Value
            ActiveCell.Offset(48, 0) = Worksheets(MyValue).Range("E16").Value
            ActiveCell.Offset(49, 0) = Worksheets(MyValue).Range("E17").Value
            ActiveCell.Offset(50, 0) = Worksheets(MyValue).Range("E18").Value
            ActiveCell.Offset(51, 0) = Worksheets(MyValue).Range("E19").Value
            ActiveCell.Offset(52, 0) = Worksheets(MyValue).Range("E20").Value

            Set 表 = ActiveCell.CurrentRegion

            With 表.Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With

            表.BorderAround xlContinuous, xlThick

        End If

    End If
    Worksheets("データ").Columns.AutoFit

End Sub

---

コメント返信：

---

[ 一覧(最新更新順) ]

---

YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.