Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
807 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【78185】エクセル内のデータ転送に関して TODD 16/5/20(金) 8:24 質問[未読]
【78186】Re:エクセル内のデータ転送に関して β 16/5/20(金) 9:31 発言[未読]
【78198】Re:エクセル内のデータ転送に関して TODD 16/5/24(火) 12:34 お礼[未読]
【78200】Re:エクセル内のデータ転送に関して β 16/5/24(火) 21:19 発言[未読]
【78205】Re:エクセル内のデータ転送に関して TODD 16/5/26(木) 1:28 お礼[未読]
【78206】Re:エクセル内のデータ転送に関して TODD 16/5/26(木) 4:29 お礼[未読]
【78207】Re:エクセル内のデータ転送に関して β 16/5/26(木) 8:03 発言[未読]
【78209】Re:エクセル内のデータ転送に関して TODD 16/5/26(木) 10:29 質問[未読]
【78187】Re:エクセル内のデータ転送に関して β 16/5/20(金) 9:39 発言[未読]
【78188】Re:エクセル内のデータ転送に関して β 16/5/20(金) 20:10 発言[未読]
【78185】エクセル内のデータ転送に関して
質問  TODD  - 16/5/20(金) 8:24 -
引用なし
パスワード
   VBAを使用し始めた初心者です。
宜しくお願い致します。　Excel 2010

(ご質問内容)
列Fに入力している言葉を検索ワードとし列Aを検索、検索ワードと一致した場合、
同じ行のB列、C列に入力された情報をG、Hに移動させ、次の行に入力されている
検索ワードで同様のことをしたいと考えております。

　　　　　　　　　　　　　　　　　　　　一回目　　　　　　　　2回目
　　 　A　　　　 B　　　C　　　　　F　　　　G　　　H　　　 I　 　 J　 K
1　 りんご1　　100円　 青森　　りんご1　　100円　 青森　りんご1　
2　 バナナ1　　 80円　 沖縄　　りんご2　　　　　　　　　りんご2
3　 みかん1 　 120円　 兵庫　　りんご3　　　　　　　　　りんご3
4　 りんご2 　 110円　 長野　　みかん1　　　　　　　　　みかん1
5　　 　　　　　　　　　　　 　みかん2　　　　　　　　　みかん2
6　 　　　　　　　　　　　　 　みかん3　　　　　　　　　みかん3
7　　 　　　　　　　　　　　 　バナナ1　　　　　　　　　バナナ1


sub くだもの
Dim i as Integer
Dim LastRow as Interger

LastRow = Range("A65500").end(xlup).Row
For i = 1 to LastRow

If range("A" & i).value = "りんご1" then
　 Range("G1").value = Range("B" & i)
　 Range("H1").value = Range("C" & i)

End if
Next
End sub

りんご1検索後、自動で次にりんご2で検索を行い、
データをG、Hに転送させるには、どうすればよいでしょうか？

また全てのF列の検索ワードのデータを転送後、
A、B、Cに新しい情報を上書きし、I、J、Kにデータを転送できるように
したいと考えております。

大変申し訳御座いませんが、ご教授して頂けないでしょうか？
宜しくお願い致します。

以上
【78186】Re:エクセル内のデータ転送に関して
発言  β  - 16/5/20(金) 9:31 -
引用なし
パスワード
   ▼TODD さん：

要件誤解あれば指摘願います。

Sub Test()
　　Dim col As Long
　　Dim adr0 As String
　　Dim adr1 As String
　　
　　col = Cells(1, Columns.Count).End(xlToLeft).Column
　　adr0 = Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 3).Address
　　
　　With Range(Cells(1, col), Cells(Rows.Count, col).End(xlUp)).Resize(, 3)
　　　　adr1 = .Cells(1).Address(False, True)
　　　　.Columns("B:C").Formula = "=IFERROR(VLOOKUP(" & adr1 & "," & adr0 & ",COLUMN(B1),FALSE),""登録なし"")"
　　　　.Value = .Value
　　End With
　　
End Sub
【78187】Re:エクセル内のデータ転送に関して
発言  β  - 16/5/20(金) 9:39 -
引用なし
パスワード
   ▼TODD さん：

↑　２回目は I列に、３回目は L列に、・・・・　と
実行前に、検索ワードを記入してあるという前提です。
そうではなく、空白で、常に、F列の検索ワードを自動コピーして使うということなら
少しコードを変更します。
【78188】Re:エクセル内のデータ転送に関して
発言  β  - 16/5/20(金) 20:10 -
引用なし
パスワード
   ▼TODD さん：

別案もアップしておきます。
２回目、３回目の条件は、先にコメントした通りです。
下記の Test2 が、TODDさんがループで処理しようとしておられた流れになるかと思います。
Test3 は、同じループなら、効率を考えて、一工夫したもの。

F列等の件数が少なければアップ済みの Test でも問題ないかと思いますが
件数が膨大ならTest3ですね。
で、残念ながら、Test2 は、最も効率の悪い方式になります。

Sub test2()
　　Dim col As Long
　　Dim i As Long
　　Dim x As Long
　　Dim mx As Long
　　
　　Application.ScreenUpdating = False
　　
　　mx = Range("A" & Rows.Count).End(xlUp).Row
　　col = Cells(1, Columns.Count).End(xlToLeft).Column
　　
　　With Range(Cells(1, col), Cells(Rows.Count, col).End(xlUp)).Resize(, 3)
　　　　For i = 1 To .Rows.Count
　　　　　　.Cells(i, 2).Resize(, 2).ClearContents
　　　　　　For x = 1 To mx
　　　　　　　　If .Cells(i, 1).Value = Cells(x, "A").Value Then
　　　　　　　　　　.Cells(i, 2).Value = Cells(x, "B").Value
　　　　　　　　　　.Cells(i, 3).Value = Cells(x, "C").Value
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　Next
　　　　Next
　　End With
　　
End Sub

Sub test3()
　　Dim dic As Object
　　Dim c As Range
　　Dim col As Long
　　Dim x As Long
　　Dim v As Variant
　　Dim w As Variant
　　
　　Set dic = CreateObject("Scripting.Dictionary")
　　
　　For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))
　　　　dic(c.Value) = c.Offset(, 1).Resize(, 2).Value
　　Next
　　
　　col = Cells(1, Columns.Count).End(xlToLeft).Column
　　v = Range(Cells(1, col), Cells(Rows.Count, col).End(xlUp)).Value
　　ReDim Preserve v(1 To UBound(v, 1), 1 To 3)
　　
　　For x = 1 To UBound(v, 1)
　　　　If dic.exists(v(x, 1)) Then
　　　　　　w = dic(v(x, 1))
　　　　　　v(x, 2) = w(1, 1)
　　　　　　v(x, 3) = w(1, 2)
　　　　End If
　　Next
　　
　　Cells(1, col).Resize(UBound(v, 1), UBound(v, 2)).Value = v
　　
End Sub
【78198】Re:エクセル内のデータ転送に関して
お礼  TODD  - 16/5/24(火) 12:34 -
引用なし
パスワード
   β さん：
ご返答有難う御座います。たいへん助かります。
こちらのご返答が遅くなり申し訳御座いません。
現在、内容を確認させて頂いておりますが、
先にTestについてご質問させて下さい。

With Range(Cells(1, col), Cells(Rows.Count, col).End(xlUp)).Resize(, 3)
→ワークシートの左側に入力されている文字の行・列を範囲を選択し、
その範囲を3行右に広げる。

それ以降の箇所はどのような意味になっているのでしょうか？
adr1 = .Cells(1).Address(False, True)
.Columns("B:C").Formula = "=IFERROR(VLOOKUP(" & adr1 & "," & adr0 & ",COLUMN(B1),FALSE),""登録なし"")"
.Value = .Value

分割して試してみたり、ネット調べてみたのですが分からず、時間が
掛かってしましました。　早急にご対応頂きましたので、申し訳御座いません。

以上


▼β さん：
>▼TODD さん：
>
>要件誤解あれば指摘願います。
>
>Sub Test()
>　　Dim col As Long
>　　Dim adr0 As String
>　　Dim adr1 As String
>　　
>　　col = Cells(1, Columns.Count).End(xlToLeft).Column
>　　adr0 = Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 3).Address
>　　
>　　With Range(Cells(1, col), Cells(Rows.Count, col).End(xlUp)).Resize(, 3)
>　　　　adr1 = .Cells(1).Address(False, True)
>　　　　.Columns("B:C").Formula = "=IFERROR(VLOOKUP(" & adr1 & "," & adr0 & ",COLUMN(B1),FALSE),""登録なし"")"
>　　　　.Value = .Value
>　　End With
>　　
>End Sub
【78200】Re:エクセル内のデータ転送に関して
発言  β  - 16/5/24(火) 21:19 -
引用なし
パスワード
   ▼TODD さん：

まず col は、１行目の右端（ＸＦＤ１）から左にみて最後にデータがある列番号。
つまり、このリストの一番右の列になりますね。

で、Range(Cells(1, col), Cells(Rows.Count, col).End(xlUp))

これは、その列の 1行目のセルからから、その列のデータ最終セルまでの領域。
かりに、２回目の場合、colが 9(つまりI列)で、I列のデータ最終行が20行目だとすると
この領域は I1:I20 になりますね。それを左に3つ広げますので I1:K20 つまり
２回目の領域全体になります。

そうしますと　adr1 = .Cells(1).Address(False, True)

これは I1:K20の領域の最初のセル　つまり I1。このアドレス文字列を取得しています。
この時、行は相対表示、列は絶対表示という指定（False,True) をしていますので
adr1 に格納される文字列は $I1 になります。

もう１つ adr0 文字列を説明しておきます。

adr0 = Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 3).Address

かりに A列データ最終行が 20 なら A1:C20 になるわけですが　Address取得時の
相対、絶対　を省略しています。省略した場合絶対になります。
したがって　$A$1:$C$20 になっています。

で、処理としては　『ある領域』に数式を埋め込んでいます。
この場合、ある領域　の左上隅にセットする数式を与えると、
シート上で右に、下にフィルコピーした場合に、式の中身が相対的に変化しますけど
それと同じ状態でセットされます。

ある領域　というのは
With Range(Cells(1, col), Cells(Rows.Count, col).End(xlUp)).Resize(, 3)
つまり、I1:K20　これの .Columns("B:C") これは２番目と３番目の列ということになりますので
J1:K20 ですね。

この左上隅のセル　つまり　J1 に

"=IFERROR(VLOOKUP(" & adr1 & "," & adr0 & ",COLUMN(B1),FALSE),""登録なし"")"

こんな式をセットしています。
変数　adr1 や adr2 を　上で説明した例になおしますと

=IFERROR(VLOOKUP($I1,$A$1:$C$20,COLUMN(B1),FALSE),"登録なし")

こうなります。
Columns(B1) って 2 ですから、この式は
=IFERROR(VLOOKUP($I1,$A$1:$C$20,2,FALSE),"登録なし")

これを右に（つまりK1)にフィルコピーすると
=IFERROR(VLOOKUP($I1,$A$1:$C$20,COLUMN(C1),FALSE),"登録なし")
つまり　=IFERROR(VLOOKUP($I1,$A$1:$C$20,3,FALSE),"登録なし")
になりますね。

いずれにしても J1 に
=IFERROR(VLOOKUP($I1,$A$1:$C$20,COLUMN(B1),FALSE),"登録なし")
を入れて、これうぃK列にフィルコピーした後下にフィルコピーしてみてください。
どのように式が変化するか、よくわかると思います。
【78205】Re:エクセル内のデータ転送に関して
お礼  TODD  - 16/5/26(木) 1:28 -
引用なし
パスワード
   ご返答有難う御座います。

これから内容を確認させて頂きたいと思います。
たいへん丁寧なご説明、有難う御座います。

以上
【78206】Re:エクセル内のデータ転送に関して
お礼  TODD  - 16/5/26(木) 4:29 -
引用なし
パスワード
   β様

ご説明して頂いた内容により、ほぼ内容を理解することが出来ました。
有難うございます！！


With Range(Cells(1, col), Cells(Rows.Count, col).End(xlUp)).Resize(, 3)
adr1 = .Cells(1).Address(False, True)
.Columns("B:C").Formula = "=IFERROR(VLOOKUP(" & adr1 & "," & adr0 & ",COLUMN(B1),FALSE),""登録なし"")"

------------------------------------------------------------------------
下記最後の行ですが、
.Value = .Value

これは下記内容になると思います。
Range(Cells(1, col), Cells(Rows.Count, col).End(xlUp)).Resize(, 3).Value
= Range(Cells(1, col), Cells(Rows.Count, col).End(xlUp)).Resize(, 3).Value

この行の導入されていなければ、エクセルの対象セルに
IFERROR(VLOOKUP($I5,$A$1:$C$12,COLUMN(C5),FALSE),"登録なし")の式が
記載され、行が導入されると式が記載されません。

I1:K20までのセルにデータを転送した後になるので、
K1:M20までの範囲の値　=　K1:M20までの範囲の値となると思います(つまり空欄)。
これがなぜ、式の記載有り、記載無しに影響を与えるのでしょうか？

何度も申し訳御座いません。

以上
【78207】Re:エクセル内のデータ転送に関して
発言  β  - 16/5/26(木) 8:03 -
引用なし
パスワード
   ▼TODD さん：

あたらずといえども遠からず？

たとえば　今、 I1:K20 の領域を対象にした処理だとします。

そうすると

With Range(Cells(1, col), Cells(Rows.Count, col).End(xlUp)).Resize(, 3)

これは

With Range("I1:K20") ということになります。

この With で指し示した領域は、その領域が、クリアされようと、何か値が入ろうと
End With まで、動きません。

したがって、.Value = .Value は　Range("I1:K20").Value = Range("I1:K20").Value
つまり、その領域全体を値変換しますので、その中の数式部分も値に置き換わるということです。
本来は、式をセットした領域の変換でいいわけですが、面倒なので、式ではなく値が入っている
領域も処理。値が値になるだけで問題はないので。
【78209】Re:エクセル内のデータ転送に関して
質問  TODD  - 16/5/26(木) 10:29 -
引用なし
パスワード
   βさん

内容が理解出来ました。
有難うございます。

以上
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
807 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free