Excel VBA質問箱 IV

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

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


19239 / 76732 ←次へ | 前へ→

【62929】Re:複数の条件で抽出したい
発言  kanabun  - 09/9/18(金) 23:33 -

引用なし
パスワード
   ▼秋刀魚 さん:

上のサンプルは コードと日付のリストを書き出すものでしたが、
該当行を別シートに書き出すなら、(Try1を少し修正して)
こんな感じになります。

Sub Try2() '別シートへ抽出
  Dim r As Range
  Dim v, s As String, w
  Dim i As Long, y As Long, x As Long
  Dim dic As Object
  Set dic = CreateObject("Scripting.Dictionary")
  '元データ
  Set r = Worksheets(1).Range("A1").CurrentRegion
  x = r.Columns.Count
  v = r.Resize(, 2).Value
  y = UBound(v)
  '「コード」別最新日付行を検索
  For i = 2 To y
   s = v(i, 2)
   If dic.Exists(s) Then
     If v(dic(s), 1) < v(i, 1) Then dic(s) = i
   Else
     dic(s) = i
   End If
  Next
  ReDim w(1 To y, 1 To 1)
  w(1, 1) = "temp"
  For Each v In dic.Keys
    i = dic(v)
    w(i, 1) = i 'コード別最新日付行を配列に書き込む
  Next
  Worksheets(2).UsedRange.ClearContents
  With r.Item(1, x + 1).Resize(y)
    .Value = w        '作業列に
    .AutoFilter 1, ">=0"   '行番号のある行だけ抽出
    r.Copy Worksheets(2).Range("A1") '別シートに転記
    .AutoFilter
    .ClearContents
  End With
  Set dic = Nothing
End Sub

1 hits

【62912】複数の条件で抽出したい 秋刀魚 09/9/15(火) 16:50 質問
【62913】Re:複数の条件で抽出したい Jaka 09/9/15(火) 17:20 発言
【62914】Re:複数の条件で抽出したい Hirofumi 09/9/15(火) 18:00 回答
【62915】Re:複数の条件で抽出したい 秋刀魚 09/9/15(火) 21:50 お礼
【62920】Re:複数の条件で抽出したい kanabun 09/9/17(木) 12:07 発言
【62929】Re:複数の条件で抽出したい kanabun 09/9/18(金) 23:33 発言

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