[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『最新情報を一番上に表示させたい』(やる気梨)
シート「1」の入力データをシート「2」、「3」等のデータを反映させたいのですが
シート「1」
A B C D E
1 氏名 山田 太郎 田山 郎太
2 所属部署 経理課 営業部
3 配属日 2010/1/1 2010/1/1
4 所属部署 総務課 経理課
5 配属日 2011/1/1 2012/1/1
6 所属部署 営業部 営業部
7 配属日 2012/1/1 2014/1/1
8 所属部署 経理課
9 配属日 2015/1/1
.
.
.
シート「2」
A B
1 氏名 山田太郎
2 所属部署 配属日
3 経理課 2015/1/1
4 営業部 2012/1/1
5 総務課 2011/1/1
6 経理課 2010/1/1
7
8
9
.
.
.
この様にシート「1」は一番最初に所属した部署、配属日から入力し、それぞれシート「2」、シート「3」では最新の部署が常に一番上の列(この場合は3列目)に来る様に出来るでしょうか。
今はシート「2」のB1に氏名を入れたら最初に所属していた部署と配属日が来る様に「HLOOKUP」関数を使用しています。
< 使用 Excel:Excel2010、使用 OS:Windows7 >
Sub abc()
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
a = 2
b = 1
Do Until a = 4
If Cells(11, 2).Value = Cells(1, a).Value Then
Do Until Cells(b, a).Value = "" b = b + 1 Loop b = b - 1 d = b c = 13 Do Until b < 2 Cells(c, 2).Value = Cells(b, a).Value b = b - 2 c = c + 1 Loop c = 13 b = d - 1 Do Until b < 1 Cells(c, 1).Value = Cells(b, a).Value b = b - 2 c = c + 1 Loop End If a = a + 1 Loop End Sub あとはそちらの状況に合わせて調整してください。
(スズメ) 2015/03/24(火) 17:00
なので、もし、上のマクロをSheet1で実行するのであれば、Do Until b < 2の下にある、Cells(c, 2).Value = Cells(b, a).Valueを、Sheets(2).Cells(c, 2).Value = Cells(b, a).Valueに、Do Until b < 1の下にある、Cells(c, 1).Value = Cells(b, a).Valueを、Sheets(2).Cells(c, 1).Value = Cells(b, a).Valueとすればできると思います。
ただ、あなたがやっていたやりかたなら、HLOOKUP関数を使用した後に、日付をもとに降順にすればいいと思うのですが、それではだめなのでしょうか?
(スズメ) 2015/03/24(火) 17:23
Sub abc()
Dim a As Integer Dim b As Integer Dim c As Integer Dim d As Integer Dim e As Integer a = 2 e = 2 Do Until e = 4 b = 1 Do Until a = 4 If Sheets(e).Cells(1, 2).Value = Cells(1, a).Value Then Do Until Cells(b, a).Value = "" b = b + 1 Loop b = b - 1 d = b c = 2 Do Until b < 2 Sheets(e).Cells(c, 2).Value = Cells(b, a).Value b = b - 2 c = c + 1 Loop c = 2 b = d - 1 Do Until b < 1 Sheets(e).Cells(c, 1).Value = Cells(b, a).Value b = b - 2 c = c + 1 Loop End If a = a + 1 Loop a = 2 e = e + 1 Loop End Sub あとは先ほどと同じくあなたの環境に合わせて調整をしてください。 (スズメ) 2015/03/24(火) 17:46
シート2は、なんとなくわかりましたが、シート3って何ですか? で、シート2ですけど、実行タイミングは、さぁ、やるぞ!というタイミングでマクロ実行ですか? それとも、B1に名前が入った時に自動実行ですか?
To (スズメ)さん
行番号や列番号関係の変数、大昔は Integer型で宣言する習慣がありましたけど、 今は(というか、大昔ではなくただの昔から)そうする意義が皆無で、ほんのちょっと処理効率にも悪影響。 (処理効率に関しては顕微鏡でのぞいてわかるぐらいですが)
というか、すべての整数はなんであれ、Long型で宣言しましょう。
あと、中途半端なインデントは、かえって見づらい感があります。
質問者さんは、回答側のコードを模範として勉強していかれるので、そのあたりにも留意いただければ。 (と、偉そうなことを言いました。これは To β としての自戒のコメントでもあります)
(β) 2015/03/24(火) 17:57
要件未確認のままですがとりあえず。
ThisWorkbookモジュールに。
Sheet2あるいはSheet3のB1に名前が入力されると自動実行。 なお、Sheet2,Sheet3のA1,A2,B2 には、あらかじめタイトルが入っているものとします。
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim col As Variant Dim sh1 As Worksheet Dim nm As String Dim w As Variant Dim i As Long Dim x As Long Dim z As Long
Application.ScreenUpdating = False
Select Case Sh.Name Case "Sheet2", "Sheet3" '★シート名は実際のものに Set sh1 = Sheets("Sheet1") '★シート名は実際のものに With Sh Application.EnableEvents = False If Not Intersect(Target, .Range("B1")) Is Nothing Then .Range("A1").CurrentRegion.Offset(2).ClearContents nm = .Range("B1").Value col = Application.Match(nm, sh1.Range("B1", sh1.Cells(1, Columns.Count).End(xlToLeft)), 0) If IsError(col) Then MsgBox nm & " は登録されていません" .Range("B1").Select Else col = col + 1 z = sh1.Cells(Rows.Count, 1).End(xlUp).Row If (z - 1) Mod 2 > 0 Then z = z + 1 ReDim w(1 To (z - 1) / 2, 1 To 2) For i = 2 To z Step 2 x = x + 1 w(x, 1) = sh1.Cells(i, col).Value w(x, 2) = sh1.Cells(i + 1, col).Value Next .Range("A3").Resize(UBound(w, 1), 2).Value = w With .Range("A1").CurrentRegion .Offset(2).Resize(.Rows.Count - 2).Sort Key1:=Columns("B"), Order1:=xlDescending, Header:=xlNo End With End If End If Application.EnableEvents = True End With End Select
End Sub
(β) 2015/03/24(火) 19:53
インテンド入れるの忘れていました。integerは確かに無駄ですがまれに役に立つときがありますよ。
誤って無限ループを作ってしまったとき、ある変数が限界を越えたときに止まってくれます。longだと止まってくれません。
なので、一応integerにしています。
将来はlongに変えるかどうかはじっくり考えたいと思います。
(スズメ) 2015/03/24(火) 20:53
シート3が、別の人のシート、シート4がまた別の人のシートというのは、想像がついています。 ポイントはいつ、どんなタイミングで実行するかということでしょうね。 シート2〜シート〇まで、あらかじめ名前が入っている。で、シート1をメンテして、さぁ、実行という運用なのか シート2〜シート〇までのいずれかのシートで、山田さんはどうかなとか、田中さんはどうかなと、入力をした時点で そのシートに対して、その名前の人の履歴を降順で表示するのか。
私がアップしたものは、後者です。
前者の処理はもちろんできます。後ほどアップします。
To (スズメ)さん
なかなか、興味深い考え、承っておきます。 たとえばエクセルのシート目いっぱい近くデータがある場合、2003ですでにInteger型変数では処理できなくなっているということも あわせて指摘しているつもりです。昨今のQ/Aでは、シートに5万件以上のデータがあるといった事例が少なくないですよね。
(β) 2015/03/24(火) 21:08
シート1以外のシートにシート1の情報を反映させるパターンです。 対象シートは、A1に"氏名" 、A2に"所属部署" 、B2に"配属日" タイトルがセットされているシートとしています。
標準モジュールに。
Sub Test() Dim col As Variant Dim sh1 As Worksheet Dim nm As String Dim w As Variant Dim i As Long Dim x As Long Dim z As Long Dim sh As Worksheet
Application.ScreenUpdating = False
Set sh1 = Sheets("Sheet1") '★シート名は実際のものに
For Each sh In Worksheets If sh.Name <> sh1.Name Then '処理妥当なシートかどうかのチェック If sh.Range("A1").Value = "氏名" And sh.Range("A2").Value = "所属部署" And sh.Range("B2").Value = "配属日" Then x = 0 sh.Range("A1").CurrentRegion.Offset(2).ClearContents nm = sh.Range("B1").Value col = Application.Match(nm, sh1.Range("B1", sh1.Cells(1, Columns.Count).End(xlToLeft)), 0) If IsError(col) Then MsgBox sh.Name & " の " & nm & " は登録されていません" & vbLf & "処理をスキップします" Else col = col + 1 z = sh1.Cells(Rows.Count, col).End(xlUp).Row If (z - 1) Mod 2 > 0 Then z = z + 1 ReDim w(1 To (z - 1) / 2, 1 To 2) For i = 2 To z Step 2 x = x + 1 w(x, 1) = sh1.Cells(i, col).Value w(x, 2) = sh1.Cells(i + 1, col).Value Next sh.Range("A3").Resize(UBound(w, 1), 2).Value = w With sh.Range("A1").CurrentRegion .Offset(2).Resize(.Rows.Count - 2).Sort Key1:=sh.Columns("B"), Order1:=xlDescending, Header:=xlNo End With End If End If End If Next End Sub
(β) 2015/03/24(火) 21:35
ただ、そんな膨大な処理はたまにしかないので、越えないときはinteger、越えるときはlongにしています。面倒くさいですが。
あと、やる気梨さんから返信がないので、最初の回答で納得して、もう返信が来なさそうな感じがします。
(スズメ) 2015/03/24(火) 21:49
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.