Excel VBA質問箱 IV

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

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


41298 / 76732 ←次へ | 前へ→

【40515】Re:検索して一致したらデータ入力
回答  Kein  - 06/7/15(土) 13:35 -

引用なし
パスワード
   Sub Test_Match()
  Dim MyR As Range, C As Range
  Dim CkS As String
  Dim x As Variant
  Dim Ary1() As Variant, Ary2() As Variant
  Dim i As Long

  With Sheets("B")
   With .Range("B2", .Range("B65536").End(xlUp)).Offset(, 26)
     .Formula = "=$B2&$C2"
     .Value = .Value
   End With
  End With
  With Sheets("A")
   Set MyR = .Range("A2", .Range("A65536").End(xlUp))
  End With
  For Each C In MyR
   CkS = C.Value & C.Offset(, 1).Value
   x = Application.Match(CkS, Sheets("B").Range("AB:AB"), 0)
   If IsError(x) Then
     ReDim Preserve Ary1(i): ReDim Preserve Ary2(i)
     Ary1(i) = C.Value, Ary2(i) = C.Offset(, 1).Value
     i = i + 1
   End If
  Next
  If i = 0 Then
   MsgBox "Bシート に見つからないデータはありません", 48
   Set MyR = Nothing: Exit Sub
  End If
  With WorksheetFunction
   Ary1 = .Transpose(Ary1)
   Ary2 = .Transpose(Ary2)
  End With
  With Sheets("B")
   With .Range("B65536").End(xlUp)
     .Offset(1).Resize(UBound(Ary1) + 1).Value = Ary1
     .Offset(1, 1).Resize(UBound(Ary2) + 1).Value = Ary2
   End With
   .Range("AB:AB").ClearContents
   .Activate
  End With
  Set MyR = Nothing: Erase Ary1, Ary2
End Sub

で、どうかな・・?
0 hits

【40481】検索して一致したらデータ入力 06/7/14(金) 15:33 質問
【40486】Re:検索して一致したらデータ入力 ichinose 06/7/14(金) 18:45 発言
【40512】Re:検索して一致したらデータ入力 06/7/15(土) 12:48 質問
【40517】Re:検索して一致したらデータ入力 ichinose 06/7/15(土) 15:10 発言
【40534】Re:検索して一致したらデータ入力 06/7/15(土) 22:37 お礼
【40544】Re:検索して一致したらデータ入力 ichinose 06/7/16(日) 8:56 発言
【40564】Re:検索して一致したらデータ入力 06/7/17(月) 22:14 お礼
【40515】Re:検索して一致したらデータ入力 Kein 06/7/15(土) 13:35 回答
【40520】Re:検索して一致したらデータ入力 06/7/15(土) 18:01 質問
【40562】Re:検索して一致したらデータ入力 kobasan 06/7/17(月) 16:20 発言
【40563】Re:検索して一致したらデータ入力 kobasan 06/7/17(月) 20:53 発言
【40565】Re:検索して一致したらデータ入力 06/7/17(月) 22:26 お礼

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