Excel VBA質問箱 IV

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

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


2263 / 13645 ツリー ←次へ | 前へ→

【69044】条件移動について シン 11/5/11(水) 23:56 質問[未読]
【69045】Re:条件移動について kanabun 11/5/12(木) 9:46 発言[未読]
【69056】Re:条件移動について シン 11/5/13(金) 0:14 質問[未読]
【69061】Re:条件移動について UO3 11/5/13(金) 12:41 発言[未読]
【69065】Re:条件移動について kanabun 11/5/13(金) 20:32 発言[未読]
【69087】Re:条件移動について シン 11/5/14(土) 18:52 お礼[未読]

【69044】条件移動について
質問  シン  - 11/5/11(水) 23:56 -

引用なし
パスワード
   はじめまして、VBA初心者です。
下記の移動後のように移動をさせたいのですが
条件があり困っております。
条件とは、sheet1のA列とsheet2のA列が同じ値の時、(sheet1 A1= sheet2 A1など A1〜A15まで比較)
sheet1のA欄と同じ値の行のB列にsheet2 Aの値をコピーできるようにしたいです。
一致しない値はそのままコピーなしです。
VBAでこのようなことは可能でしょうか?結果は下記の2.移動後のとうりに
したいです。毎回「A」の値は変わるので変わることを考慮できるように
したいっです。
すいませんがご教授いただきますようお願いします。
-----------------------------------------------------------
1.移動前
sheet1               sheet2

  A  B  C  D        A   B   C   D   E
1 0.8             1 0.8  国  0.81     TN
2 1.2             2 1.3  数  1.31     BN
3 1.6             3 1.6  理  1.61     BN
4 1.7             4 2.0  家  2.01     TN
5 2.0             5 2.1  図  2.11     BN
.
.
5 5.5
---------------------------------------------------------------
2.移動後
sheet1               sheet2

  A  B  C  D        A   B   C   D   E
1 0.8 0.8  国 0.81      1 0.8  国  0.81     TN
2 1.2              2 1.3  数  1.31     BN
3 1.6 1.6  理 1.61   ←  3 1.6  理  1.61     BN
4 1.7              4 2.0  家  2.01     TN
5 2.0 2.0  家 2.1       5 2.1  図  2.11     BN
.
.
15 5.5

【69045】Re:条件移動について
発言  kanabun  - 11/5/12(木) 9:46 -

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

>sheet1のA列とsheet2のA列が同じ値の時、(sheet1 A1= sheet2 A1など A1〜A15まで比較)
>sheet1のA欄と同じ値の行のB列にsheet2 Aの値をコピーできるようにしたいです。

処理行数がそんなに多くなさそうなので、
ワークシート関数Matchで sheet1のA列のセル値を sheet2のA列に求め
あったら その行をコピペするサンプルです。

Sub Try1()        'WS2 → WS1
  Dim WS1 As Worksheet
  Dim WS2 As Worksheet
  Dim r1 As Range, c As Range
  Dim r2 As Range
  Dim r22 As Range
  
  Set WS1 = Worksheets("Sheet1")
  Set WS2 = Worksheets("Sheet2")
  
  Set r1 = WS1.Range("A1", WS1.Cells(WS1.Rows.Count, 1).End(xlUp))
  Set r2 = WS2.Range("A1", WS2.Cells(WS2.Rows.Count, 1).End(xlUp))
  Set r22 = r2.Offset(, 1).Resize(, 4)
  Dim m
  r1.Offset(, 1).Resize(, 4).ClearContents
  For Each c In r1
    m = Application.Match(c, r2, 0)
    If IsNumeric(m) Then
      r22.Rows(m).Copy c(1, 2)
    End If
  Next
  
End Sub

【69056】Re:条件移動について
質問  シン  - 11/5/13(金) 0:14 -

引用なし
パスワード
   ご質問に答えて頂きましてありがとうございます。
しかし。マッチ関数をどのように使用したら良いか
わかりません。
申し訳ございませんが教えて頂けないでしょうか?


▼kanabun さん:
>▼シン さん:
>
>>sheet1のA列とsheet2のA列が同じ値の時、(sheet1 A1= sheet2 A1など A1〜A15まで比較)
>>sheet1のA欄と同じ値の行のB列にsheet2 Aの値をコピーできるようにしたいです。
>
>処理行数がそんなに多くなさそうなので、
>ワークシート関数Matchで sheet1のA列のセル値を sheet2のA列に求め
>あったら その行をコピペするサンプルです。
>
>Sub Try1()        'WS2 → WS1
>  Dim WS1 As Worksheet
>  Dim WS2 As Worksheet
>  Dim r1 As Range, c As Range
>  Dim r2 As Range
>  Dim r22 As Range
>  
>  Set WS1 = Worksheets("Sheet1")
>  Set WS2 = Worksheets("Sheet2")
>  
>  Set r1 = WS1.Range("A1", WS1.Cells(WS1.Rows.Count, 1).End(xlUp))
>  Set r2 = WS2.Range("A1", WS2.Cells(WS2.Rows.Count, 1).End(xlUp))
>  Set r22 = r2.Offset(, 1).Resize(, 4)
>  Dim m
>  r1.Offset(, 1).Resize(, 4).ClearContents
>  For Each c In r1
>    m = Application.Match(c, r2, 0)
>    If IsNumeric(m) Then
>      r22.Rows(m).Copy c(1, 2)
>    End If
>  Next
>  
>End Sub

【69061】Re:条件移動について
発言  UO3  - 11/5/13(金) 12:41 -

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

>ご質問に答えて頂きましてありがとうございます。
>しかし。マッチ関数をどのように使用したら良いか
>わかりません。

横から失礼します。

どのようにVBAで使用するかということについては、すでに
kanabunさんのサンプルコードで提示いただいていますよね。

m = Application.Match(c, r2, 0)

ここです。

というか、シート上でMatch関数を使った式をセルに入れることは
できますか?

=MATCH(検索セル範囲,検索の値またはセル,照合の型)

ですが、もし、ここもご存じなければ、ヘルプで勉強をしておいてください。

で、多くの、シート関数はVBAでも使うことができます。
基本としては WorkSheetFunction.関数(●●●・・・・) として使いますが
MatchやVLOOKUP 等、見つからない時に #N/A 等のエラーになるケースがありますね。
WorkSheetFunction.関数 とやると、このケースで実行時エラーでVBA処理がとまってしまいます。
このようなときの対処方法として、よく使われるのが
Application.関数ちう使い方。この書き方をしておけば、VBAはストップせず
戻り値に(m = のところ)「エラー値」がかえってきますので、戻り値が数値だったかどうかを
If IsNumeric(m) Then でチェックしているわけです。

【69065】Re:条件移動について
発言  kanabun  - 11/5/13(金) 20:32 -

引用なし
パスワード
   ▼シン さん:
>しかし。マッチ関数をどのように使用したら良いか
>わかりません。

UO3さんからMatch関数について分かりやすい説明がありました。

コードに少し説明(コメント)をつけてみました。
> 1.移動前
> sheet1               sheet2
>
>   A  B  C  D        A   B   C   D   E
> 1 0.8             1 0.8  国  0.81     TN
> 2 1.2             2 1.3  数  1.31     BN
> 3 1.6             3 1.6  理  1.61     BN
> 4 1.7             4 2.0  家  2.01     TN
> 5 2.0             5 2.1  図  2.11     BN
> .
> .
> 5 5.5
> ---------------------------------------------------------------
>
> Sub Try1()        'WS2 → WS1
  ---------------------------------------- ここから
>   Dim WS1 As Worksheet
>   Dim WS2 As Worksheet
>   Dim r1 As Range, c As Range
>   Dim r2 As Range
>   Dim r22 As Range
>  -------------------------------- ここまでは使用する変数の宣言です

  ↓ここから実行部で、
   まず 変数WS1,WS2 に具体的なシートをセットしています。
   シート名"Sheet1" とか"Sheet2" はブックにより変わることがあります。
   コードのあちこちに「実名」でシートを書いておくと、変更があった時
   直すのが大変です。最初に一度だけ、変数に代入しておけば、
   変更があっても、この一か所を直すだけで済みます。
>   Set WS1 = Worksheets("Sheet1")
>   Set WS2 = Worksheets("Sheet2")
>   
   ↓同じように、2つのシートのA列の処理対象範囲を変数r1,r2にセットして
    おきます。r1 はWS1(転記先シート)のA列範囲、
         r2 はWS2(転記元シート)のA列範囲です。
    なお、WS1.Cells(WS1.Rows.Count, 1).End(xlUp) は手動操作でいうと、
     WS1シートのA列最終行を選択して、そこで Ctrl+[↑]を押したときの
     処理に相当します(→A列最後のデータのあるセルが求まります)
>   Set r1 = WS1.Range("A1", WS1.Cells(WS1.Rows.Count, 1).End(xlUp))
>   Set r2 = WS2.Range("A1", WS2.Cells(WS2.Rows.Count, 1).End(xlUp))

  ↓ついでに、コピーするWS2のB〜E列範囲も変数r22 にセットしておきます。
    (r2というA列データ範囲を1つ右すなわちB列にシフトした範囲を4列に
    拡張したセル範囲、という意味です)
>   Set r22 = r2.Offset(, 1).Resize(, 4)


  以上で処理対象範囲のセットが終わりましたので、
   いよいよWS1のr1範囲の各セルを順にLoopして、各セルの値(数値)が
    WS2のA列にも存在するか、Match関数を使って調べることにします。
>   Dim m
   ↑Match関数で検索した結果をこのmという変数に入れることにします。
    m はmatchから名づけた変数です。

   ↓処理を実行する前に、転記先の範囲を白紙状態にしておきます。
>   r1.Offset(, 1).Resize(, 4).ClearContents

   ↓r1 セル範囲のLoopを開始します(r1範囲が具体的に [A1:A15]であれば、
    Loop一回目は cに[A1]セルが入り、2回目には[A2]セルが入ります)
>   For Each c In r1

     ↓セルc の値とマッチするセルが r2範囲にあるか、調べます
>     m = Application.Match(c, r2, 0)

     ↓ r2範囲に cセルとマッチするセルがあれば、
      マッチした行番号が返ります。
      ※ マッチするセルがなかったときは「エラー値」が返ります。
      ↓したがって、マッチするセルが見つかったかどうかは
        mの値が数値であるかどうか(IsNumeric関数)で判定できます
        IsNumeric(数値の1) = True ですが、
        IsNumeric(Error値) = False というわけです。
>     If IsNumeric(m) Then
      ↑マッチするセルがあったばあい、
       ↓r22範囲のその行を
         WS1の検索元セルの右隣にコピーしてやります
>       r22.Rows(m).Copy c(1, 2)
>     End If
>   Next
  ↑以上をr1範囲内のすべてのセルに対し順に実行します。
>   
> End Sub

【69087】Re:条件移動について
お礼  シン  - 11/5/14(土) 18:52 -

引用なし
パスワード
   みなさん本当にありがとうございます。
なんとか完成することができました〜


▼kanabun さん:
>▼シン さん:
>>しかし。マッチ関数をどのように使用したら良いか
>>わかりません。
>
>UO3さんからMatch関数について分かりやすい説明がありました。
>
>コードに少し説明(コメント)をつけてみました。
>> 1.移動前
>> sheet1               sheet2
>>
>>   A  B  C  D        A   B   C   D   E
>> 1 0.8             1 0.8  国  0.81     TN
>> 2 1.2             2 1.3  数  1.31     BN
>> 3 1.6             3 1.6  理  1.61     BN
>> 4 1.7             4 2.0  家  2.01     TN
>> 5 2.0             5 2.1  図  2.11     BN
>> .
>> .
>> 5 5.5
>> ---------------------------------------------------------------
>>
>> Sub Try1()        'WS2 → WS1
>  ---------------------------------------- ここから
>>   Dim WS1 As Worksheet
>>   Dim WS2 As Worksheet
>>   Dim r1 As Range, c As Range
>>   Dim r2 As Range
>>   Dim r22 As Range
>>  -------------------------------- ここまでは使用する変数の宣言です
>
>  ↓ここから実行部で、
>   まず 変数WS1,WS2 に具体的なシートをセットしています。
>   シート名"Sheet1" とか"Sheet2" はブックにより変わることがあります。
>   コードのあちこちに「実名」でシートを書いておくと、変更があった時
>   直すのが大変です。最初に一度だけ、変数に代入しておけば、
>   変更があっても、この一か所を直すだけで済みます。
>>   Set WS1 = Worksheets("Sheet1")
>>   Set WS2 = Worksheets("Sheet2")
>>   
>   ↓同じように、2つのシートのA列の処理対象範囲を変数r1,r2にセットして
>    おきます。r1 はWS1(転記先シート)のA列範囲、
>         r2 はWS2(転記元シート)のA列範囲です。
>    なお、WS1.Cells(WS1.Rows.Count, 1).End(xlUp) は手動操作でいうと、
>     WS1シートのA列最終行を選択して、そこで Ctrl+[↑]を押したときの
>     処理に相当します(→A列最後のデータのあるセルが求まります)
>>   Set r1 = WS1.Range("A1", WS1.Cells(WS1.Rows.Count, 1).End(xlUp))
>>   Set r2 = WS2.Range("A1", WS2.Cells(WS2.Rows.Count, 1).End(xlUp))
>
>  ↓ついでに、コピーするWS2のB〜E列範囲も変数r22 にセットしておきます。
>    (r2というA列データ範囲を1つ右すなわちB列にシフトした範囲を4列に
>    拡張したセル範囲、という意味です)
>>   Set r22 = r2.Offset(, 1).Resize(, 4)
>
>
>  以上で処理対象範囲のセットが終わりましたので、
>   いよいよWS1のr1範囲の各セルを順にLoopして、各セルの値(数値)が
>    WS2のA列にも存在するか、Match関数を使って調べることにします。
>>   Dim m
>   ↑Match関数で検索した結果をこのmという変数に入れることにします。
>    m はmatchから名づけた変数です。
>
>   ↓処理を実行する前に、転記先の範囲を白紙状態にしておきます。
>>   r1.Offset(, 1).Resize(, 4).ClearContents
>
>   ↓r1 セル範囲のLoopを開始します(r1範囲が具体的に [A1:A15]であれば、
>    Loop一回目は cに[A1]セルが入り、2回目には[A2]セルが入ります)
>>   For Each c In r1
>
>     ↓セルc の値とマッチするセルが r2範囲にあるか、調べます
>>     m = Application.Match(c, r2, 0)
>
>     ↓ r2範囲に cセルとマッチするセルがあれば、
>      マッチした行番号が返ります。
>      ※ マッチするセルがなかったときは「エラー値」が返ります。
>      ↓したがって、マッチするセルが見つかったかどうかは
>        mの値が数値であるかどうか(IsNumeric関数)で判定できます
>        IsNumeric(数値の1) = True ですが、
>        IsNumeric(Error値) = False というわけです。
>>     If IsNumeric(m) Then
>      ↑マッチするセルがあったばあい、
>       ↓r22範囲のその行を
>         WS1の検索元セルの右隣にコピーしてやります
>>       r22.Rows(m).Copy c(1, 2)
>>     End If
>>   Next
>  ↑以上をr1範囲内のすべてのセルに対し順に実行します。
>>   
>> End Sub

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