Excel VBA質問箱 IV

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

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


6251 / 13644 ツリー ←次へ | 前へ→

【46361】統計的な処理の実現には? Holic 07/1/31(水) 21:20 質問[未読]
【46380】Re:統計的な処理の実現には? ハチ 07/2/1(木) 12:35 発言[未読]
【46386】Re:統計的な処理の実現には? Kein 07/2/1(木) 15:38 回答[未読]

【46361】統計的な処理の実現には?
質問  Holic  - 07/1/31(水) 21:20 -

引用なし
パスワード
   質問です。
重複のないデータがsheet1に8000〜9000件あります。
sheet1は次の内容です。
 A   B   C  D     E
北海道  A市 a町 男爵   20.40
       z村 メークィ 67.81
新潟   B市 b町 ミルク  50.37
          温泉   25.85
          スキー  4.21
青森   C市 c町 りんご  88.00

各都道府県の産業TOPを(E列で高い数字のもの)抜粋するにはどうすれば
よいでしょうか?

シートは例のように抜けている部分がありますが、意味するところは
北海道にはA市とB市があり、A市にはa町とz村がある。
抜粋結果は都道府県に1個という形でお願いします。
北海道  A市 z村 メークィ 67.81
新潟   B市 b町 ミルク  50.37
青森   C市 c町 りんご  88.00

【46380】Re:統計的な処理の実現には?
発言  ハチ  - 07/2/1(木) 12:35 -

引用なし
パスワード
   ▼Holic さん:
>質問です。
>重複のないデータがsheet1に8000〜9000件あります。
>sheet1は次の内容です。
> A   B   C  D     E
>北海道  A市 a町 男爵   20.40
>       z村 メークィ 67.81
>新潟   B市 b町 ミルク  50.37
>          温泉   25.85
>          スキー  4.21
>青森   C市 c町 りんご  88.00
>
>各都道府県の産業TOPを(E列で高い数字のもの)抜粋するにはどうすれば
>よいでしょうか?
>
>シートは例のように抜けている部分がありますが、意味するところは
>北海道にはA市とB市があり、A市にはa町とz村がある。
>抜粋結果は都道府県に1個という形でお願いします。
>北海道  A市 z村 メークィ 67.81
>新潟   B市 b町 ミルク  50.37
>青森   C市 c町 りんご  88.00

空白の部分は結合されていたりしますか?
空白を補完して正規化した表にすれば、
処理しやすくなると思います。

もしくは、End(xlUp)でデータがある行取得していくか、ですね。

範囲内の何行目が最大の値を持っているかは、
関数でも求めることができます。

例)D1〜D5の中で最大の値を持つ行は?
=MATCH(LARGE(D1:D5,1),D1:D5,0)

【46386】Re:統計的な処理の実現には?
回答  Kein  - 07/2/1(木) 15:38 -

引用なし
パスワード
   8000〜9000件もあると、うまくいくかどうか分からないけど・・。

Sub Picup_MaxVal()
  Dim MyR As Range, C As Range
  Dim Tp As String, Ad As String
 
  Application.ScreenUpdating = False
  Sheets("Sheet1").Activate
  On Error Resume Next
  Rows.Hidden = False
  Range("IV:IV").ClearContents
  Range("A:C").SpecialCells(3).ClearContents
  Err.Clear: On Error GoTo 0
  Set MyR = Range("A:A").SpecialCells(2, 2)
  On Error Resume Next
  For Each C In MyR
   Tp = C.Offset(, 4).Address(0)
   If IsEmpty(C.Offset(1).Value) Then
     If C.End(xlDown).Row < 65536 Then
      With Range(C, C.End(xlDown).Offset(-1))
        Ad = .Offset(, 4).Address
        .Offset(, 255).Formula = _
        "=IF(" & Tp & "<>MAX(" & Ad & "),1)"
      End With
     Else
      If C.Row < Range("E65536").End(xlUp).Row Then
        With Range(C.Offset(, 4), Range("E65536").End(xlUp))
         Ad = .Address
         .Offset(, 251).Formula = _
         "=IF(" & Tp & "<>MAX(" & Ad & "),1)"
        End With
      Else
        C.Offset(, 255).Formula = "=FALSE"
      End If
     End If
   Else
     C.Offset(, 255).Formula = "=FALSE"
   End If
  Next
  Range("A1").CurrentRegion.SpecialCells(4).FormulaR1C1 = "=R[-1]C"
  Range("IV:IV").SpecialCells(3, 1).EntireRow.Hidden = True
  Application.ScreenUpdating = True: Set MyR = Nothing
End Sub

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