[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『自動的に入力される方法』（ﾖｯｼｰ）
【名簿シート】 ｜クラス｜氏 名｜身 長｜体重｜年齢｜趣味｜ ｜ Ａ ｜○○氏｜１５０｜４０｜１３｜鉄棒｜ ｜ Ｂ ｜××氏｜１４０｜３７｜１１｜料理｜ ｜ Ｄ ｜▲▲氏｜１６３｜５５｜１５｜読書｜ ｜ Ｃ ｜▽▽氏｜１５８｜４３｜２０｜車 ｜ ｜ Ｂ ｜●●氏｜１８２｜６５｜２６｜釣り｜ ｜ Ａ ｜◎◎氏｜ ： ｜： ｜： ｜： ｜ ｜ Ｃ ｜★★氏｜ ： ｜： ｜： ｜： ｜ ｜ Ｄ ｜☆☆氏｜ ： ｜： ｜： ｜： ｜ ｜ ： ｜ ： ｜ ： ｜： ｜： ｜： ｜ 【クラスＡシート】 ｜クラス｜氏 名｜身 長｜体重｜年齢｜趣味｜ ｜ Ａ ｜○○氏｜１５０｜４０｜１３｜鉄棒｜ ｜ Ａ ｜◎◎氏｜ ： ｜： ｜： ｜： ｜
名簿シートに延々とデーターが入力され、クラスＡシートにはＡクラスの人が自動的に入力される方法はありますか？マクロかなぁ？？
どうぞ宜しくお願い致します。
自動ではないけどオートフィルタ（データ オートフィルタで出来ます） もあります。 （クラブババ）
クラブババさんご回答ありがとう御座います。
しかしどうしても、シートを移動させたいのです。
移動先シートにて色々記載が既にありまして･･･その中にクラス別の
データーを振り分けたいのです。
どうぞ宜しくお願い致します。
クラブババさんのご意見は、オートフィルタで抽出して、 コピー、貼り付けはどうですか、ということだと思いますけど、 それではダメでしょうか。 必要ならその作業をマクロに登録することもできますし。
配列数式など、関数でもできなくもありませんが、 「名簿シートに延々とデーターが入力され、」 とありますので、大量のデータだと重くなりますので、 あまりお勧めできません。 (sato)
衝突しちゃいました。 satoさん、補足ありがとうございます。 というより、私の説明不足で申し訳ない限りです。 オートフィルタで抽出し、それを貼り付けるという意味です。
似た内容の質問も何ヶ月か前に見た気もします。 （クラブババ）
クラブババさんの方法をそのままマクロの自動記述で記録すると、
Sub Macro1()
Sheets("名簿").Select
Selection.AutoFilter Field:=1, Criteria1:="A"
Range("A1:F20").Select
Selection.Copy
Sheets("クラスA").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
となります。
100件程度なら関数でもいけそうです。
シート「名簿」
A B C D E F
1 クラス 氏名 身長 体重 年齢 趣味
2 A ○○ 150 40 13 鉄棒
3 B ×× 140 37 11 料理
4 D ▲▲ 163 55 15 読書
5 C ▽▽ 158 43 20 車
6 B ●● 182 65 26 釣り
7 A ◎◎ 175 70 18 お花
8 C ★★ 168 58 40 映画
9 D ☆☆ 158 42 35 お経
シート「クラスＡ」
A B C D E F
1 クラス 氏名 身長 体重 年齢 趣味
2 A ○○ 150 40 13 鉄棒
3 A ◎◎ 175 70 18 お花
4
5
シート「クラスＡ」で、 A2に A と入力 A3=IF(B3="","",A2) B2=IF(COUNTIF(名簿!$A$2:$A$100,$A$2)<ROW(A1),"" ,INDEX(名簿!B$2:B$100,SMALL(IF($A$2=名簿!$A$2:$A$100,ROW($A$1:$A$99)),ROW(A1))))
B2の式は配列数式ですから、入力後CtrlとShiftキーを押しながらEnterで確定してください。 B2の式をF列までコピー、そのまま適当に下方向にもコピーするとこのようになります。 (sato)
衝突～（笑 あっら～、折角マクロ作ったのに先手とられましたなぁ。 マクロやったらこうなるっちゅう事でいっぺん試してみておくんなはれ。
試しにですから新しいブックに名簿、クラスA、クラスB、クラスC、クラスD っちゅう塩梅にシートを作成してくらはい。 注意点はABCDの英字は必ず半角にしてくださいよ。（とても重要）
名簿のシートモジュールに
'-------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Cells(Target.Row, 1)
Case "A"
shtflagA = True
Case "B"
shtflagB = True
Case "C"
shtflagC = True
Case "D"
shtflagD = True
End Select
End Sub
'------------------------------
'クラスAのシートモジュールに
'-----------------------------
Private Sub Worksheet_Activate()
If shtflagA Then
shtname = ActiveSheet.Name
macro (shtname)
shtflagA = False
End If
End Sub
'----------------------------
'クラスBのシートモジュールに
'-----------------------------
Private Sub Worksheet_Activate()
If shtflagB Then
shtname = ActiveSheet.Name
macro (shtname)
shtflagB = False
End If
End Sub
'---------------------------
'クラスCのシートモジュールに
'-------------------------
Private Sub Worksheet_Activate()
If shtflagC Then
shtname = ActiveSheet.Name
macro (shtname)
shtflagC = False
End If
End Sub
'----------------------------
'クラスDのシートモジュールに
'--------------------------
Private Sub Worksheet_Activate()
If shtflagD Then
shtname = ActiveSheet.Name
macro (shtname)
shtflagD = False
End If
End Sub
'---------------------------
’をそれぞれコピペしておくんなはれ
’標準モジュールに
'----------------------
Option Explicit
Public shtflagA As Boolean
Public shtflagB As Boolean
Public shtflagC As Boolean
Public shtflagD As Boolean
Sub macro(shtname)
Dim dic As Object
Dim ary, tbl
Dim i As Long, n As Integer
Set dic = CreateObject("scripting.dictionary")
Columns("a:f").ClearContents
With Sheets("名簿")
tbl = .Range("a2").Resize(.Range("a65536").End(xlUp).Row - 1, 6).Value
For i = 1 To UBound(tbl, 1)
ReDim ary(1 To UBound(tbl, 2))
If "クラス" & tbl(i, 1) = shtname Then
For n = 1 To UBound(tbl, 2)
ary(n) = tbl(i, n)
Next n
dic(dic.Count) = ary
End If
Next i
End With
If dic.Count > 0 Then
Columns("a:f").ClearContents
Cells(1, 1).Resize(, UBound(tbl, 2)) = Array("クラス", "氏名", "身長", "体重", "年齢", "趣味")
Cells(2, 1).Resize(dic.Count, 6) = Application.Transpose(Application.Transpose(dic.items))
End If
Set dic = Nothing
End Sub
'-----------------------------
Sub auto_open()
shtflagA = True
shtflagB = True
shtflagC = True
shtflagD = True
End Sub 'をコピペして 'シート名簿にまぁこんな塩梅にデータを放り込んでくらはい。
A B C D E F
1クラス 氏名 身長 体重 年齢 趣味
2 A 赤星 158 55 13 野球
3 C 田淵 170 80 19 写真
4 B 西野 165 55 18 水泳
5 C 中西 174 92 22 読書
6 D 関山 168 58 20 セレブ
7 A 久保 166 62 18 日曜大工
8 B 鳥谷 152 49 15 釣り
9 D 片岡 182 82 21 ゴルフ
10 A 稲村 162 48 16 旅行
保存後そのBookを閉じて再度開くか、またはauto_openを実行してそれぞれシートを開 いてみると・・・どうでっか？ 毎度データを更新しないよう作りましたんでコードが長くなりました。 まぁ、まぁ、とりあえずいっぺん試してみまひょで。 ほな（弥太郎）
不具合が発生するおそれがありますもんで、名簿のシートモジュールは下記のコード
に変更しておくんなはれ
（弥太郎）
'名簿のシートモジュールへ
'-----------------------
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column > 6 Then Exit Sub
n = Target.Count
rowNo = Target.Row
Call submacro(n, rowNo)
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 Then
n = Target.Count
rowNo = Target.Row
Call submacro(n, rowNo)
End If
End Sub
Sub submacro(n, rowNo)
If n > 1 Then
shtflagA = True
shtflagB = True
shtflagC = True
shtflagD = True
Else
Select Case Cells(rowNo, 1)
Case "A"
shtflagA = True
Case "B"
shtflagB = True
Case "C"
shtflagC = True
Case "D"
shtflagD = True
End Select
End If
End Sub
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.