Results of 1 - 1 of about 1215 for （Mook）
(0.001 sec.)
- [[20150326225242]]
- #score: 9211
- @digest: ff97e2bd03a6255d96a9259a1fc69f5f
- @id: 67609
- @mdate: 2015-03-27T06:39:16Z
- @size: 9731
- @type: text/plain
- #keywords: ズメ (23562), 5592 (18816), に55 (17540), スズ (15403), 生再 (10097), メ) (7096), ト発 (6643), に田 (6459), 列1 (5176), isarray (3809), until (3430), デン (2703), 列2 (2520), ンテ (2469), preserve (2404), 再開 (2357), テン (2334), integer (2162), 行目 (2108), 田中 (2017), ブロ (2001), 要素 (1860), 目に (1663), ンデ (1569), 鈴木 (1521), 格納 (1486), 2015 (1459), cells (1430), enableevents (1396), loop (1334), 金) (1326), redim (1298)
- 『完全一致検索(複数列)』（いっちゃん）
dataを格納したsheet1とdataを抜出表示させるsheet2があり、 sheet1のセルには A列1行目に5592、2行目に5593、3行目に5583、4行目に5592 B列1行目に田中、2行目に田中、3行目に鈴木、4行目に鈴木 が入っています。 ここで、sheet2のX列1行目に田中と入力すると、 sheet2のA列1行目に5592、B列1行目に田中と sheet2のA列2行目に5593、B列2行目に田中と表示され、 今度は、sheet2のX列1行目に5592と入力すると、 sheet2のA列1行目に5592、B列1行目に田中と sheet2のA列2行目に5592、B列2行目に鈴木と表示され、 最後に、sheet2のX列1行目に5583と入力すると、 sheet2のA列1行目に5583、B列1行目に鈴木と表示される このようなマクロを組みたいのですが、可能でしょうか。 ＜ 使用 Excel:Excel2010、使用 OS:WindowsXP ＞ ---- 一応できましたが変数の格納の仕方が少しわからないのであとは他の人に任せます。 Sub aaa() Dim a As Integer Dim b As Integer Dim c(50) As Integer Dim d As Integer Dim e As Integer a = 1 b = 1 Do Until b = 3 Do Until a = 6 If Sheets(2).Cells(1, 4).Value = Cells(a, b).Value Then Cells(1, 5).Value = a c(1) = a d = 2 a = a + 1 Do Until a = 6 If Sheets(2).Cells(1, 4).Value = Cells(a, b).Value Then c(d) = a d = d + 1 End If a = a + 1 Loop e = d d = 1 Do Until d = e Sheets(2).Cells(d, 1).Value = Cells(c(d), 1).Value Sheets(2).Cells(d, 2).Value = Cells(c(d), 2).Value d = d + 1 Loop Exit Sub End If a = a + 1 Loop a = 1 b = b + 1 Loop End Sub （スズメ） 2015/03/27(金) 00:13 ---- Sheet2 のシートモジュール（シートタブを右クリック、コードの表示を選ぶ）に。 Private Sub Worksheet_Change(ByVal Target As Range) Dim inp As Variant Dim col As Long Dim c As Range Dim v As Variant If Intersect(Range("X1"), Target) Is Nothing Then Exit Sub 'X1 への入力以外は終了 Application.EnableEvents = False '無駄なイベント発生の抑止 Range("A1").CurrentRegion.ClearContents '転記領域のクリア inp = Range("X1").Value If IsNumeric(inp) Then '入力が数字か? col = 1 'Sheet1 の A列を検索 Else col = 2 'Sheet2 の B列を検索 End If For Each c In Sheets("Sheet1").Range("A1").CurrentRegion.Columns(col).Cells 'Sheet1の検索列からセルを抜きだし If c.Value = inp Then 'X1に入力されたものとの比較 If IsArray(v) Then ReDim Preserve v(1 To UBound(v) + 1) '2回目以降は配列の要素を1つ増やす Else ReDim v(1 To 1) '最初なら配列初期化 End If v(UBound(v)) = c.EntireRow.Range("A1:B1").Value '配列の最後の要素に格納 End If Next '該当のものがあれば、それを一括転記 If IsArray(v) Then Range("A1").Resize(UBound(v), 2).Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(v)) Application.EnableEvents = True 'イベント発生再開 End Sub （β） 2015/03/27(金) 08:04 ---- Sheet1 の データ件数が多く、検索ヒットが少ない場合は以下のほうが少し効率的。 (データ件数が少なかったり、検索ヒットが、結構多ければ、先にアップしたコードのほうが効率的。） 同じくシートモジュールに。 Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range Dim v As Variant Dim f As Range Dim r As Range If Intersect(Range("X1"), Target) Is Nothing Then Exit Sub 'X1 への入力以外は終了 Application.EnableEvents = False '無駄なイベント発生の抑止 Range("A1").CurrentRegion.ClearContents '転記領域のクリア Set r = Sheets("Sheet1").Range("A1").CurrentRegion 'Sheet1 検索領域 Set c = r.Find(what:=Range("X1").Value, LookAt:=xlWhole) '入力された値で検索 If Not c Is Nothing Then '検索でマッチすれば Set f = c '最初に見つかったセルを記憶 Do If IsArray(v) Then ReDim Preserve v(1 To UBound(v) + 1) '2回目以降は配列の要素を1つ増やす Else ReDim v(1 To 1) '最初なら配列初期化 End If v(UBound(v)) = c.EntireRow.Range("A1:B1").Value '配列の最後の要素に格納 Set c = r.FindNext() '検索 「次へ」 Loop While f.Address <> c.Address '最初に見つかったものに戻るまで繰り返し '一括転記 Range("A1").Resize(UBound(v), 2).Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(v)) End If Application.EnableEvents = True 'イベント発生再開 End Sub （β） 2015/03/27(金) 08:24 ---- 変数の格納の仕方がわかったので、2015/03/27(金) 00:13のマクロを修正します。 Sub aaa() Dim a As Integer Dim b As Integer Dim c() As Integer Dim d As Integer Dim e As Integer a = 1 b = 1 Do Until b = 3 Do Until a = 6 If Sheets(2).Cells(1, 4).Value = Cells(a, b).Value Then Cells(1, 5).Value = a ReDim c(1) c(1) = a d = 2 a = a + 1 Do Until a = 6 If Sheets(2).Cells(1, 4).Value = Cells(a, b).Value Then ReDim Preserve c(d) c(d) = a d = d + 1 End If a = a + 1 Loop e = d d = 1 Do Until d = e Sheets(2).Cells(d, 1).Value = Cells(c(d), 1).Value Sheets(2).Cells(d, 2).Value = Cells(c(d), 2).Value d = d + 1 Loop Exit Sub End If a = a + 1 Loop a = 1 b = b + 1 Loop End Sub あとはいっちゃんさんの環境に合わせて変更してください。 （スズメ） 2015/03/27(金) 13:36 ---- 余計なお世話かもしれませんが、スズメさんのインデントの独自スタイルは 矯正してはどうでしょうか。 見づらいだけでなく、バグの元かと思います。 例えば、If が入れ子になったときなど、スズメさん風だとインデントが付かないので ブロックの範囲がわかりません。 If A = 1 Then If B = 2 Then MsgBox "Apple" Else MsgBox "Blue" End If Else If C = 3 Then MsgBox "Cat" Else MsgBox "Dog" If D = 4 Then MsgBox "Egg" Else MsgBox "Fish" End If End If End If これでは、どの条件のときにどのメッセージが出るのか、 どの If と どの End If が対応しているかわからないかと思います。 If A = 1 Then If B = 2 Then MsgBox "Apple" Else MsgBox "Blue" End If Else If C = 3 Then MsgBox "Cat" Else MsgBox "Dog" If D = 4 Then MsgBox "Egg" Else MsgBox "Fish" End If End If End If と書いた方がわかりやすくないですか? （Mook） 2015/03/27(金) 14:09 ---- if関数もインテンドが必要とは知りませんでした。すいません。 （スズメ） 2015/03/27(金) 14:49 ---- >if関数もインテンドが必要とは知りませんでした。すいません。 あやまる必要はまったっくないですよ。 ただ、必要かどうかより、(スズメ)さんにとって見やすいかどうか、わかりやすいかどうかということなんです。 当初と比べて、大きなブロックごとではインデントをそろえておられるので、ずいぶん（いくぶん?）見やすくなっていると思いますが それでも Do Until a = 6 If Sheets(2).Cells(1, 4).Value = Cells(a, b).Value Then ReDim Preserve c(d) c(d) = a d = d + 1 End If a = a + 1 Loop なんかは Do Until a = 6 If Sheets(2).Cells(1, 4).Value = Cells(a, b).Value Then ReDim Preserve c(d) c(d) = a d = d + 1 End If a = a + 1 Loop このほうが(スズメ)さんご自身にとっても見やすくないですか? ところで、この Do Until a = 6 の 6 って何ですか? それと、「Sheet2のX列1行目」つまり X1 に入力するんですけど、X1のチェックはどこでしておられますか? （β） 2015/03/27(金) 14:52 ---- 細かいことだが。 IF関数はワークシートで使える関数。 VBAで使っているのはIF構文（ステートメント）。 IF関数に対応するのはIif関数になる。 また、インデントを行うのはIF構文のブロック形式になる。 （ねむねむ） 2015/03/27(金) 14:59 ---- if文については、ifの重複が少ない時は、インテンドがなくても十分理解できるので、要らないと思いますが(インテンドを入れるのは面倒なので)、10個くらい重複する時は要ると思います。 Xは本当にX列を意味するのでしょうか?Xはよく数学の方程式で使われるので、オールマイティの意味で使われている可能性は否定できません。つまり、どこの列でも使えるということです。 それに、なぜX列じゃないといけないのでしょうか?AやB列に書き込むのに、X列は遠すぎると思うのですが。 あと、6というのはあくまで実験でやったので、そこは質問者様のデータ数に合わせるということです。 （スズメ） 2015/03/27(金) 15:32 ---- >インテンドを入れるのは面倒なので VBE画面でタブキーを押すだけのことですが? >あと、6というのはあくまで実験でやったので、そこは質問者様のデータ数に合わせるということです。 データが増減するたびにコードを書き直すということですか? ★もともとのテーマとは、だんだんかけ離れて行ってますね。（私も反省） そろそろ、（ここでは）打ち止めにしましょう。 （いっちゃん） さん、スレ汚してごめんなさいね。 （β） 2015/03/27(金) 15:37... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201503/20150326225242.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97012 documents and 608132 words.
訪問者：