Excel VBA質問箱 IV

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

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


10919 / 13646 ツリー ←次へ | 前へ→

【19164】検索について seya 04/10/24(日) 11:15 質問[未読]
【19165】Re:検索について かみちゃん 04/10/24(日) 12:00 回答[未読]
【19168】Re:検索について ちゃっぴ 04/10/24(日) 13:37 回答[未読]
【19172】Re:検索について seya 04/10/24(日) 15:38 質問[未読]
【19173】Re:検索について かみちゃん 04/10/24(日) 15:48 発言[未読]
【19174】Re:検索について seya 04/10/24(日) 17:12 質問[未読]
【19175】Re:検索について かみちゃん 04/10/24(日) 17:21 回答[未読]
【19177】Re:検索について ちゃっぴ 04/10/24(日) 17:58 回答[未読]
【19178】Re:検索について seya 04/10/24(日) 18:10 お礼[未読]

【19164】検索について
質問  seya  - 04/10/24(日) 11:15 -

引用なし
パスワード
   Sheet1のB1セルの数値が、Sheet2のB列の数値で一致するセルがあった場合、Sheet1のB1を含むその行を、Sheet2の一致した行に上書きするにはどうしたらいいのでしょうか。 よろしくお願いします。

【19165】Re:検索について
回答  かみちゃん  - 04/10/24(日) 12:00 -

引用なし
パスワード
   >Sheet1のB1セルの数値が、Sheet2のB列の数値で一致するセルがあった場合、Sheet1のB1を含むその行を、Sheet2の一致した行に上書きするにはどうしたらいいのでしょうか。

Sheet1のB1セルの数値がSheet2のB列にあるかどうかを検索するという方法をとります。それには、Findメソッドを使えばできます。
あとは、一致した行全体をSheet1のB1セルを含む行、つまり1行目にコピーをします。

Findメソッドのヘルプの使用例と、行全体を別のシートの行全体にコピーする方法をマクロの記録でしてみて、加工すれば、以下のコードができました。
Sheet1をアクティブにして、実行してみてください。

Sub Macro1()
 With Sheets("Sheet2").Columns("B")
  Set c = .Find(Range("B1"), LookIn:=xlValues)
  If Not c Is Nothing Then
   '検索値に一致行全体をコピーする
   Sheets("Sheet2").Rows(c.Row).Copy
   Range("A1").Select
   ActiveSheet.Paste
   Application.CutCopyMode = False
  Else
   MsgBox "検索値が見つかりません"
  End If
 End With
 Range("A1").Select
End Sub

【19168】Re:検索について
回答  ちゃっぴ  - 04/10/24(日) 13:37 -

引用なし
パスワード
   ▼seya さん:
>Sheet1のB1セルの数値が、Sheet2のB列の数値で一致するセルがあった場合、Sheet1のB1を含むその行を、Sheet2の一致した行に上書きするにはどうしたらいいのでしょうか。 よろしくお願いします。

こういったMatchingの方法はいろいろありますが・・・
とりあえず、基本的なMatchingアルゴリズムを書いておきます。

双方のデータをSortしてから、総当りでMatchingしているものですが、
配列を用いているため、高速なはずです。

他に、高速なものとしてはDictionaryを用いたものとかあります。
興味があったらチャレンジしてみては?

Const MAX_LONG = &H7FFFFFFF

Sub test1()
  Dim rngList1 As Range
  Dim rngList2 As Range
  Dim rngTemp1 As Range
  Dim rngTemp2 As Range
  Dim lngRowC1 As Long
  Dim lngRowC2 As Long
  Dim vntList1 As Variant
  Dim vntList2 As Variant
  Dim lngUCol1 As Long
  Dim i As Long, j As Long, k As Long
  
  'Sheet1
  Set rngList1 = Worksheets("Sheet1").Cells(1).CurrentRegion
  With rngList1
    'B列で昇順Sort
    .Sort Key1:=.Item(2), Order1:=xlAscending, Header:=xlGuess, _
      OrderCustom:=1, MatchCase:=True, Orientation:=xlTopToBottom, _
      SortMethod:=xlStroke, DataOption1:=xlSortNormal
    
    lngRowC1 = .Rows.Count
    
    'Matching漏れをなくすため、B列の最終行にLong型の最大値を付与
    Set rngTemp1 = .Item(2).Offset(lngRowC1)
    rngTemp1.Value = MAX_LONG
    
    '配列に代入
    vntList1 = .Resize(lngRowC1 + 1).Value
  End With
  
  
  lngUCol1 = UBound(vntList1, 2)
  
  'Sheet2
  Set rngList2 = Worksheets("Sheet2").Cells(1).CurrentRegion
  With rngList2
    'B列で昇順Sort
    .Sort Key1:=.Item(2), Order1:=xlAscending, Header:=xlGuess, _
      OrderCustom:=1, MatchCase:=True, Orientation:=xlTopToBottom, _
      SortMethod:=xlStroke, DataOption1:=xlSortNormal
    
    lngRowC2 = .Rows.Count
    
    'Matching漏れをなくすため、B列の最終行にLong型の最大値を付与
    Set rngTemp2 = .Item(2).Offset(lngRowC2)
    rngTemp2.Value = MAX_LONG
      
    Set rngList2 = .Resize(lngRowC2 + 1, lngUCol1)
    '配列に代入
    vntList2 = rngList2.Value
  End With

  
  i = 1
  j = 1
  
  'Matching
  Do
    Select Case vntList1(i, 2)
      Case Is < vntList2(j, 2)
        i = i + 1
      Case Is = vntList2(j, 2)
        '値のコピー
        For k = 1 To lngUCol1
          vntList2(j, k) = vntList1(i, k)
        Next k
        j = j + 1
      Case Is > vntList2(j, 2)
        j = j + 1
    End Select
  Loop Until i > lngRowC1 + 1 Or j > lngRowC2 + 1
  
  '結果の出力
  rngList2.Value = vntList2
  
  'Temp数字のクリア
  rngTemp1.ClearContents
  rngTemp2.ClearContents
End Sub

【19172】Re:検索について
質問  seya  - 04/10/24(日) 15:38 -

引用なし
パスワード
   ▼ちゃっぴ さん & かみちゃんさん
早速の回答ありがとうございました。
さっそくtestさせていただきましたが、ちゃっぴさんの場合”コンパイルエラー”名前つき引数が見つかりません”とエラーメッセージがでて止まってしまいます。
またかみちゃんさんの場合、Sheet1の1行目にsheet2と同じ値があった場合はコピーされるのですが、2行目以降にある場合は、”検索値が見あたりません”とでてしまいます。
どうしてでしょうか。

【19173】Re:検索について
発言  かみちゃん  - 04/10/24(日) 15:48 -

引用なし
パスワード
   こんにちは。かみちゃんです。

>Sheet1の1行目にsheet2と同じ値があった場合はコピーされるのですが、2行目以降にある場合は、”検索値が見あたりません”とでてしまいます。

当然です。
「Sheet1のB1セルの数値が、Sheet2のB列の数値で一致するセルがあった場合」という条件しか考えていません。
つまり、2行目以降にあった場合は、検索していないというか、あくまで、B1のセルの値を検索しています。
B1に何も値がなければ、「検索値が見当たらない」にしています。

もしかして、B1だけではなくて、B1、B2、B3・・・・とあるのでしょうか?
それとも、B1ではなくて、B2または、B3にある場合もあるのでしょうか?

【19174】Re:検索について
質問  seya  - 04/10/24(日) 17:12 -

引用なし
パスワード
   ▼かみちゃん さん:
>こんにちは。かみちゃんです。
>
>>Sheet1の1行目にsheet2と同じ値があった場合はコピーされるのですが、2行目以降にある場合は、”検索値が見あたりません”とでてしまいます。
>
>当然です。
>「Sheet1のB1セルの数値が、Sheet2のB列の数値で一致するセルがあった場合」という条件しか考えていません。
>つまり、2行目以降にあった場合は、検索していないというか、あくまで、B1のセルの値を検索しています。
>B1に何も値がなければ、「検索値が見当たらない」にしています。
>
>もしかして、B1だけではなくて、B1、B2、B3・・・・とあるのでしょうか?
>それともB2または、B3にある場合もあるのでしょうか?

説明不足でお手数をかけ申し訳ありません。
Sheet1にはB1だけでなく、B2 B3・・・・・とデーターがはいっています。
Sheet2のB1セルと、Sheet1のB列では一致するセル番号は1つしかありません。
何度もすみませんがよろしくご指導のほどお願いします。

【19175】Re:検索について
回答  かみちゃん  - 04/10/24(日) 17:21 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>Sheet1にはB1だけでなく、B2 B3・・・・・とデーターがはいっています。
>Sheet2のB1セルと、Sheet1のB列では一致するセル番号は1つしかありません。

以下のコードでどうでしょうか?
B1、B2、B3・・・と「空白でない限り(<>"")」順番に繰り返し処理をしていきます。

Sub Macro1()
 Dim RowNo As Long
 Dim c As Range
 
 Worksheets("Sheet1").Select
 RowNo = 1
 Do While Cells(RowNo, 2).Value <> ""
  With Worksheets("Sheet2").Columns("B")
   Set c = .Find(Cells(RowNo, 2).Value, LookIn:=xlValues)
   If Not c Is Nothing Then
    '検索値に一致したらコピーする
    Sheets("Sheet2").Rows(c.Row).Copy
    Cells(RowNo, 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
   Else
    MsgBox "検索値が見つかりません"
   End If
  End With
  RowNo = RowNo + 1
 Loop
 Range("A1").Select
End Sub

【19177】Re:検索について
回答  ちゃっぴ  - 04/10/24(日) 17:58 -

引用なし
パスワード
   > さっそくtestさせていただきましたが、ちゃっぴさんの場合
> ”コンパイルエラー”名前つき引数が見つかりません”とエラーメッセージが
> でて止まってしまいます。

こういった場合、コンパイルエラーの箇所が黄色くポイントされると
思いますので、それを必ず書くようにしてください。

まあ、今回の場合、Excel2000以前にはSortメソッドの引数に

> DataOption1:=xlSortNormal

これが存在しませんので、これを削除すればいいかと思います。


あと、このプログラムがどのように動作しているか理解できましたか?

それがわからずに、「動きませんでした」ではレスした意味がありません。
(レスする気がうせます・・・)
「ちょっと考えて見てわかりませんでした。」という場合も、
多いかと思いますが、そういった場合も、全てがわからないという
ケースは少ないと思います。
(「全てがわからない」というなら、すみませんが基礎からお勉強ください。)

ヘルプなりで、自分で調べてもどうしてもわからないようでしたら、
「どこどこの処理がちょっと理解できません。
 もうちょっと詳しく説明していただけますか?」
のような感じで質問されるとよいかと思います。

私は、VBAでのプログラムの製作を請け負ったのではなく、
コードをどのように書けばいいかというのを教えているのです。

プログラムを理解せずに動けばOKという方には、
二度とレスをしたいとは思いませんのでその点はご注意ください。

【19178】Re:検索について
お礼  seya  - 04/10/24(日) 18:10 -

引用なし
パスワード
   ▼ちゃっぴ さん &かみちゃんさん
ちゃっぴさん
大変失礼いたしました。私なりに色々勉強しているのですが、なかなか思うようにゆかずつい簡単な気持ちで質問してしまいました。
もう少し私なりの回答を提示した後、質問をすればよかったと反省しています。
色々ご迷惑をかけて申し訳ありませんでした。

かみちゃんさん
ありがとうございました。解決しました。

これから試行錯誤しながら勉強して行きたいと思います。
もしわからなくなったときはまたご指導のほどよろしくお願いします。

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