[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『変更で・・・・』（MADO）
配列を勉強しています。よろしくおねがいします。
こちらのサイトで、下のVBAを使わせてもらってます。
Sub 配列でTranspose()
Dim tbl As Variant
Dim r As Long
Dim lastRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
tbl = Range("B9").Resize(lastRow, 1)
For r = 1 To lastRow
tbl(r, 1) = Trim(StrConv(tbl(r, 1), vbNarrow))
Next
Range("A2").Resize(, lastRow) = WorksheetFunction.Transpose(tbl)
End Sub
A列9行目から下に連番、B列9行目から下にデータが入力されています（データは空白あり）。
連番の行数はその時によって違います。
B列9行目から下のデータを配列に入れて、このシートのA2から横に貼り付けています。
（A列１行目は横に連番をふっています。）
シート＜１＞
A B C D E F G H・・・
1 1 2 3 4 5 6 7 8・・・
2 （こ の 行 に デ ー タ が 張 り 付 く）
3
4
5
6
7
8 連番 データ
9 1
10 2 イチゴ
11 3 みかん
12 4
13 5 もも
14 6
15 7 なし
・ ・
・ ・
・ ・
・
このたび、2つほど変更がありました。
どのようにコードを変えたらいいのでしょうか？
変更（1）
A列9行目から下の連番のセルが、所々結合されていて、それに合わせてB列9行目から下のデータも結合されています。
変更（2）
A列の連番とB列のデータの続きが、DE列、GH列にはいっています。よろしくお願いします。
変更後
シート＜１＞
A B C D E F G H・・・
1 1 2 3 4 5 6 7 8・・・
2 イチゴ ばなな なし 缶詰め
3
4
5
6
7
8 連番1 データ1 連番2 データ2 連番3 データ3
9 1 8 12 あし
10 2 イチゴ 9 みみ (上のセルと結合)
11 (上のセルと結合) 10 おでこ 13
12 3 (上のセルと結合) 14 手
13 4 ばなな 11 15
14 (上のセルと結合) (上のセルと結合)
15 (上のセルと結合) 16
16 5 なし
17 6
18 7 缶詰め
19 (上のセルと結合)
＜ 使用 Excel：Excel2007、使用 OS：Windows7 ＞
これって、IFERROR とVLOOKUP の組み合わせの３セットの１つの数式でできませんか？
（β） 2015/07/06(月) 20:49
（MADO） 2015/07/06(月) 21:05
Sub test()
Dim dic As Object
Dim v1, v2, v3
Dim i As Long
Set dic = CreateObject("scripting.dictionary")
v1 = Range("A9", Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
v2 = Range("D9", Range("D" & Rows.Count).End(xlUp)).Resize(, 2).Value
v3 = Range("G9", Range("G" & Rows.Count).End(xlUp)).Resize(, 2).Value
For i = 1 To UBound(v1)
If Not IsEmpty(v1(i, 1)) Then dic(v1(i, 1)) = v1(i, 2)
Next
For i = 1 To UBound(v2)
If Not IsEmpty(v2(i, 1)) Then dic(v2(i, 1)) = v2(i, 2)
Next
For i = 1 To UBound(v3)
If Not IsEmpty(v3(i, 1)) Then dic(v3(i, 1)) = v3(i, 2)
Next
Range("A2").Resize(, dic.Count).Value = dic.items()
End Sub
（マナ） 2015/07/06(月) 21:53
>>逆に関数教えて欲しいです。
ベタベタな式ですけど、A2 に =IFERROR(VLOOKUP(A1,$A9:$B1000,2,FALSE),IFERROR(VLOOKUP(A1,$C9:$D1000,2,FALSE),IFERROR(VLOOKUP(A1,$E9:$F1000,2,FALSE),"")))
これを右にフィルコピーとか。
（β） 2015/07/06(月) 22:13
（マナ） 2015/07/06(月) 22:19
会社では最近、みんなでマクロの勉強をしています。
教えてもらったコードの他に、どのようなコードで処理できるでしょうか。
よろしくお願いいたします。
（MADO） 2015/07/08(水) 07:25
>>会社では最近、みんなでマクロの勉強をしています。 >>教えてもらったコードの他に、どのようなコードで処理できるでしょうか。
処理効率を考慮するとマナさんの回答のようにDictionaryを使う方法等があるわけですが これから勉強ということであれば、処理効率は悪くなりますが、基本的なループ処理構文案の１つとして。
Test2 は、基本構文、Test2_2 は、Test2 と全く同じことをしていますが、少し、コードをコンパクトに また、効率も少しだけ改善した応用型構文です。
Sub Test2()
Dim maxCol As Long
Dim i As Long, j As Long, x As Long
Dim num As Variant
Dim ans As Variant
Dim z As Variant
'1行目の指定文字がどの列まではいっているかを取得
maxCol = Range("A1").End(xlToRight).Column
'1列目(A列)から最終列までの1行目の値を処理
For x = 1 To maxCol
num = Cells(1, x).Value
ans = Empty
'シート関数MATCHを使って検索
z = Application.Match(num, Range("A9:A19"), 0)
If Not IsError(z) Then
ans = Range("B" & z + 8).Value
Else
z = Application.Match(num, Range("D9:D19"), 0)
If Not IsError(z) Then
ans = Range("E" & z + 8).Value
Else
z = Application.Match(num, Range("G9:H19"), 0)
If Not IsError(z) Then
ans = Range("H" & z + 8).Value
End If
End If
End If
'結果を2行目に転記
Cells(2, x).Value = ans
Next
End Sub
Sub Test2_2()
Dim num As Variant
Dim ans As Variant
Dim x As Long
Dim y As Long
Dim z As Variant
'1行目の文字列を検索用配列に格納
num = Range("A1", Range("A1").End(xlToRight)).Value
'結果用配列準備
ReDim ans(1 To UBound(num, 2))
'検索用配列の値でチェックし結果用配列に格納
For x = 1 To UBound(num, 2)
'最大3回のMATCH検索
For y = Columns("A").Column To Columns("G").Column Step 3
z = Application.Match(num(1, x), Cells(9, y).Resize(11), 0)
If IsNumeric(z) Then
ans(x) = Cells(z + 8, y + 1).Value
Exit For
End If
Next
Next
Range("A2").Resize(, UBound(ans)).Value = ans
End Sub
（β） 2015/07/08(水) 09:07
もう１例。エクセルの検索機能を使った処理案です。 結果は直接セルに書きこんでいますが、Test2_2 と同じように配列に格納しておいて最後に一括転記もできます。
Sub Test3()
Dim c As Range
Dim r As Range
Dim f As Range
'検索対象領域 列最初が結合セルの可能性を考慮し、あえてタイトル行を含める。
Set r = Range("A8:A19,D8:D19,G8:G19")
With Range("A1", Range("A1").End(xlToRight)) '検索元領域
.Offset(1).ClearContents '事前に結果領域をクリア
For Each c In .Cells '検索元から１つずつ取り出す
Set f = r.Find(what:=c.Value, lookat:=xlWhole) 'Findメソッドによる検索
If Not f Is Nothing Then c.Offset(1).Value = f.Offset(, 1).Value 'マッチすればセット
Next
End With
End Sub
（β） 2015/07/08(水) 09:28
そろそろ打ち止めにしますが、Dictionaryと配列を使った例です。 Dictionaryと配列の役割をマナさんの方法とは逆にしています。
Sub Test4()
Dim dic As Object
Dim ans As Variant
Dim c As Range
Dim x As Long
Set dic = CreateObject("Scripting.Dictionary")
For Each c In Range("A9:A19,D9:D19,G9:G19")
If Not IsEmpty(c) Then dic(c.Value) = c.Offset(, 1).Value
Next
With Range("A1", Range("A1").End(xlToRight))
ReDim ans(1 To .Columns.Count)
For Each c In .Cells
x = x + 1
ans(x) = dic(c.Value)
Next
End With
Range("A2").Resize(, UBound(ans)).Value = ans
End Sub
（β） 2015/07/08(水) 09:35
（MADO） 2015/07/08(水) 18:44
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.