[[20080220105955]]　『抽出方法について』（初心者）　ページの最後に飛ぶ

『抽出方法について』（初心者）

 　
　月　　　取引先　取引先コード　
　　　　　　　　　　　　　　　　　　　　　　月　　　取引先名　取引先コード
　
2007/10　　A社　　 　　111　　　
　　　　　　　　　　　　　　　　　　　　　　2007/12　　　A社　　　　111
　
2007/11　　A社　　 　　111　　　　　　　　　2007/11　　　B社　　　　222
2007/12　　A社　　 　　111　　　　　　　　　2007/11　　　C社　　　　333
2007/10　　B社　　 　　222　　　⇒　　　
2007/11　　B社     　　222
2007/9　　 C社     　　333
2007/10　　C社     　　333
2007/11　　C社     　　333
　
上記図の様に各社に対して一番新しい月のみを抽出する事は可能でしょうか？
もし抽出方法をご存知の方がいればご教授下されば有難いです。
宜しくお願いします。

 データ、集計で、グループの基準に取引先、集計の方法に最小値、集計するフィールドに月を指定し、
 ＯＫとし、出現した表の左上の□の2をクリックしますと、作表できますが、レイアウトが
 お好みにマッチするかどうかは、？？です。　　　　　　　　　　　　　　　　　　(6UP)

 マクロでの一例です。
  但し，元データはA,B列を逆に配置して実行してください。
 結果もA,B列逆に出ます。

  シート1のA,B,C列に上記データを記載して実行するとシート2に結果が出ます。
      なおシート2のB列は日付書式に設定しておいてください。
      （マクロでも可ですが，省略していますので）
   A,B,C・・・・社の並び連続でなくて飛んでいてもOKです。

  本コードは，[[20080213140737]]に類似のためにそこに提示のコードを少し変更したものです。
   処理速度の論議はそちらの掲示板を参照ください。（夕焼）

 Sub test()

 ''''''''''''''''''' A列重複データ抽出整理

 Worksheets(2).Cells(1, 1) = Worksheets(1).Cells(1, 1)
 lastrow1 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row

 For i = 2 To lastrow1
   nn = 0
   lastrow2 = Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row

   For j = 1 To lastrow2

       If Worksheets(2).Cells(j, 1) = Worksheets(1).Cells(i, 1) Then
       Exit For

       Else
       nn = nn + 1
       End If
    Next j

   If nn = lastrow2 Then
   Worksheets(2).Cells(lastrow2 + 1, 1) = Worksheets(1).Cells(i, 1)

   End If

 Next i

 lastrow21 = Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row

  '''''''''''''''''B列データ検索

  For k = 1 To lastrow1
    For m = 1 To lastrow21
   If Worksheets(2).Cells(m, 1) = Worksheets(1).Cells(k, 1) Then

       If Worksheets(2).Cells(m, 2) < Worksheets(1).Cells(k, 2) Then
        Worksheets(2).Cells(m, 2) = Worksheets(1).Cells(k, 2)
         Worksheets(2).Cells(m, 3) = Worksheets(1).Cells(k, 3)
         End If

    End If
    Next m

    Next k

 End Sub

 回答ではありませんが
 >本コードは，[[20080213140737]]～
[[20080213140737]]
 リンク先に飛べるように記載願えませんか？
 (元夏バテ)

 変数の宣言の無い不安定なコードの使用は避けましょう。

 Sub test()
 Dim a, b(), i As Long, ii As Integer, n As Long, x
 a = Range("a1").CurrentRegion.Resize(,3).Value
 ReDim b(1 To UBound(a,1), 1 To UBound(a,2))
 With CreateObject("Scripting.Dictionary")
     For i = 1 To UBound(a,1)
         If Not .exists(a(i,2)) Then
             n = n + 1
             For ii = 1 To UBound(a,2)
                 b(n,ii) = a(i,ii)
             Next
             .add a(i,2), n
         Else
             x = .item(a(i,2))
             If a(i,1) > b(x, 1) Then
                 For ii = 1 To UBound(a,2)
                     b(n,ii) = a(i,ii)
                 Next
             End If
         End If
     Next
 End With
 Range("e1").Resize(n,3).Value = b
 End Sub
 (seiya)

コメント返信：

[ 一覧(最新更新順) ]

[[20080220105955]] 『抽出方法について』（初心者） ページの最後に飛ぶ

[[20080220105955]]　『抽出方法について』（初心者）　ページの最後に飛ぶ