Excel VBA質問箱 IV

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

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


3163 / 13644 ツリー ←次へ | 前へ→

【63809】別シートからのデータ検索と挿入 yumi 09/12/17(木) 11:17 質問[未読]
【63810】Re:別シートからのデータ検索と挿入 ぴかる 09/12/17(木) 11:23 発言[未読]
【63811】Re:別シートからのデータ検索と挿入 yumi 09/12/17(木) 11:30 発言[未読]
【63812】Re:別シートからのデータ検索と挿入 ぴかる 09/12/17(木) 11:55 発言[未読]
【63813】Re:別シートからのデータ検索と挿入 yumi 09/12/17(木) 12:11 発言[未読]
【63815】Re:別シートからのデータ検索と挿入 ぴかる 09/12/17(木) 13:27 発言[未読]
【63816】Re:別シートからのデータ検索と挿入 SS 09/12/17(木) 13:37 発言[未読]
【63818】Re:別シートからのデータ検索と挿入 yumi 09/12/17(木) 13:51 お礼[未読]
【63819】Re:別シートからのデータ検索と挿入 ぴかる 09/12/17(木) 13:55 発言[未読]
【63820】Re:別シートからのデータ検索と挿入 yumi 09/12/17(木) 14:16 お礼[未読]
【63821】Re:別シートからのデータ検索と挿入 Yuki 09/12/17(木) 14:33 発言[未読]
【63822】Re:別シートからのデータ検索と挿入 Yuki 09/12/17(木) 14:50 発言[未読]
【63823】Re:別シートからのデータ検索と挿入 yumi 09/12/17(木) 15:59 お礼[未読]

【63809】別シートからのデータ検索と挿入
質問  yumi  - 09/12/17(木) 11:17 -

引用なし
パスワード
   はじめまして。VBAを勉強中のゆみです。
どうしてもうまくいかず教えていただけないでしょうか。

シート「一覧」

ボール  バット  グローブ
100    1000    10000
200    2000    20000
300    3000    30000
-------------------------------------------
シート「データ」

ボール  ball
バット  bat
グローブ glove
-------------------------------------------

と2つのシートがあったときにシート一覧を

シート「一覧」

ボール  バット  グローブ
ball   bat    glove
100    1000    10000
200    2000    20000
300    3000    30000
-------------------------------------------

と、いう風に「データ」シートから英語名を検索して
2行目にそれを追加したいと思っています。

簡単そうなのですが、、、どうしてもうまくいかず。。。
どなたか教えていただけませんでしょうか。
よろしくお願いいたします。

【63810】Re:別シートからのデータ検索と挿入
発言  ぴかる  - 09/12/17(木) 11:23 -

引用なし
パスワード
   yumiさん、こんにちは。

VBAでなく、数式のVLOOKUP関数で出来ると思います。
ご確認下さい。

【63811】Re:別シートからのデータ検索と挿入
発言  yumi  - 09/12/17(木) 11:30 -

引用なし
パスワード
   ▼ぴかる さん:
お返事ありがとうございます。

プログラム的にVBAの処理の中にこの処理も組み込みたいと思ってまして
できればVBAでと思っています。

言葉足らずでごめんなさい。
よろしくお願いします。

ゆみ

【63812】Re:別シートからのデータ検索と挿入
発言  ぴかる  - 09/12/17(木) 11:55 -

引用なし
パスワード
   色んなやり方が有ると思います。
一例として

Sub サンプル()
  
Dim I As Integer
Dim J As Integer

  Rows(2).Insert Shift:=xlDown
  For I = 1 To 3
    For J = 1 To 3
      If Cells(1, I).Value = Sheets("データ").Cells(J, 1).Value Then
        Cells(2, I).Value = Sheets("データ").Cells(J, 2).Value
      End If
    Next
  Next

End Sub

【63813】Re:別シートからのデータ検索と挿入
発言  yumi  - 09/12/17(木) 12:11 -

引用なし
パスワード
   ▼ぴかる さん

早速の返信ありがとうございます。
なるほどですー。
列の件数などは固定ではなくて変動しそうなので
そこのloopの部分は頑張って見ますね。

1点だけ分かれば教えてください。
「データ」のシート方なのですが、検索対象のデータが
数万件ありまして、nextで回すと想像より時間がかかってしまいました。
その他のやり方もありますでしょうか。

よろしくお願いします。

【63815】Re:別シートからのデータ検索と挿入
発言  ぴかる  - 09/12/17(木) 13:27 -

引用なし
パスワード
   こんなんもです。

Sub サンプル2()
 
Dim I As Integer

  Rows(2).Insert Shift:=xlDown
  For I = 1 To Range("A1").End(xlToRight).Column
    Cells(2, I).Value = Application.VLookup(Cells(1, I).Value, Sheets("データ").Range("A1").CurrentRegion, 2, False)
  Next
  
End Sub

【63816】Re:別シートからのデータ検索と挿入
発言  SS  - 09/12/17(木) 13:37 -

引用なし
パスワード
   ▼yumi さん:
>▼ぴかる さん
横から失礼します。
  For I = 1 To 3
    For J = 1 To 数万件
      If Cells(1, I).Value = Sheets("データ").Cells(J, 1).Value Then
        Cells(2, I).Value = Sheets("データ").Cells(J, 2).Value
      End If
    Next
  Next
ですとCells(1, I).Value = Sheets("データ").Cells(J, 1).Valueが一致した後も
For Jが数万件分実行されるため時間がかかります。
      If Cells(1, I).Value = Sheets("データ").Cells(J, 1).Value Then
        Cells(2, I).Value = Sheets("データ").Cells(J, 2).Value
        Exit For ’<===追加
      End If
とすると少し早くなると思います。さらに頻度の高い検索対象のデータを
上部に配置すると効果が大きくなります。

あと、画面表示の更新を一時的に停止する、配列に取り込み処理して一括書き出し
などあると思います。

>
>早速の返信ありがとうございます。
>なるほどですー。
>列の件数などは固定ではなくて変動しそうなので
>そこのloopの部分は頑張って見ますね。
>
>1点だけ分かれば教えてください。
>「データ」のシート方なのですが、検索対象のデータが
>数万件ありまして、nextで回すと想像より時間がかかってしまいました。
>その他のやり方もありますでしょうか。
>
>よろしくお願いします。

【63818】Re:別シートからのデータ検索と挿入
お礼  yumi  - 09/12/17(木) 13:51 -

引用なし
パスワード
   ▼SS さん:
▼ぴかる さん

ありがとうございました!!
教えていただきました内容で進めてみます。

ありがとうございました。

【63819】Re:別シートからのデータ検索と挿入
発言  ぴかる  - 09/12/17(木) 13:55 -

引用なし
パスワード
   おまけです。
これが一番速いかも?

Sub サンプル3()
  
  Rows(2).Insert Shift:=xlDown
  Range("A2") = "=VLOOKUP(A1,データ!$A$1:$B$" & Sheets("データ").Range("A1").End(xlDown).Row & ",2,FALSE)"
  Range("A2").Copy
  With Range(Cells(2, 1), Cells(2, Range("A1").End(xlToRight).Column))
    .PasteSpecial Paste:=xlPasteFormulas
    .Copy
    .PasteSpecial Paste:=xlPasteValues
  End With
  Application.CutCopyMode = False
  
End Sub

【63820】Re:別シートからのデータ検索と挿入
お礼  yumi  - 09/12/17(木) 14:16 -

引用なし
パスワード
   ▼ぴかる さん:

ありがとうございます!!!
先ほどのでも動作は確認できました。

3つ目のやつでも試してみますね!!

【63821】Re:別シートからのデータ検索と挿入
発言  Yuki  - 09/12/17(木) 14:33 -

引用なし
パスワード
   ▼yumi さん:
これもおまけで。
行挿入はいちどだけですからテストの時は注意して下さいね。
Sub TESTa2()
  Dim Dic As Object
  Dim v1 As Variant
  Dim i  As Long
  Dim v2 As Variant
  With Worksheets("データ")
    v1 = .Range("A1").CurrentRegion.Resize(, 2).Value
  End With
  Set Dic = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(v1)
    Dic(v1(i, 1)) = v1(i, 2)
  Next
  With Worksheets("一覧")
'    .Rows(2).Insert
    v2 = .Range("A1").CurrentRegion.Resize(2).Value
  End With
  For i = 1 To UBound(v2, 2)
    If Dic.Exists(v2(1, i)) Then
      v2(2, i) = Dic(v2(1, i))
      Debug.Print v2(2, i)
    End If
  Next
  With Worksheets("一覧")
    .Range("A1").Resize(2, UBound(v2, 2)).Value = v2
  End With
End Sub

【63822】Re:別シートからのデータ検索と挿入
発言  Yuki  - 09/12/17(木) 14:50 -

引用なし
パスワード
   ▼yumi さん:
忘れ物です。
>'    .Rows(2).Insert
↑このコメントを外してください。
>    v2 = .Range("A1").CurrentRegion.Resize(2).Value
>  End With
>  For i = 1 To UBound(v2, 2)
>    If Dic.Exists(v2(1, i)) Then
>      v2(2, i) = Dic(v2(1, i))
>      Debug.Print v2(2, i)
       ↑の行をコメントにして下さい。
>    End If
>  Next

【63823】Re:別シートからのデータ検索と挿入
お礼  yumi  - 09/12/17(木) 15:59 -

引用なし
パスワード
   ▼Yuki さん:

ありがとうございますー!!!
こちらも試してみますね!!!

皆様、ありがとうございます。

3163 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free