特定の文字列が含まれる文字列の最大・最小を別シートに書き込む

Question

特定の文字列が含まれる文字列の最大・最小を求める方法を教えていただきたいです。

――――――――――――――――――――――――――――――――――――――――
■ 概要 （添付画像を参照しながらご確認ください）
――――――――――――――――――――――――――――――――――――――――

A列の最終行まで、PGAの文字列を見つけて

項目2と項目3の最大・最小を別シートに書き出したい。

という要望です。

素人な質問で申し訳ございません。よろしくお願いいたします

Sheet1 参照元

Sheet2 編集先

Comments

[Youbun]

自分でどこまでソースを書いたのか。
どこで詰まっているのか書いてくれたら回答が来やすいと思います。

[asde]

ご指摘誠にありがとうございます。

Answer 1

丸投げ質問は推奨されませんが、これは私の興味からコードを書いてみた結果です。
詳しくは書きませんので解析は自力でお願いします。

Sub sample()
    Dim shSrc As Worksheet
    Dim shDst As Worksheet
    Dim srcRng As Variant
    Dim fc As Range
    Dim r As Long
    Dim last As Long
    
    Set shSrc = Worksheets("Sheet1")
    Set shDst = Worksheets("Sheet2")
    
    srcRng = shSrc.Range("A1").CurrentRegion
    
    For r = 2 To UBound(srcRng)
        If InStr(srcRng(r, 1), "PGA") > 0 Then
            With shDst
                Set fc = .Range("A:A").Find(srcRng(r, 1))
                If fc Is Nothing Then
                    last = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                    If last = 2 Then last = 3
                    .Cells(last, 1) = srcRng(r, 1)
                    .Cells(last, 2) = srcRng(r, 3)
                    .Cells(last, 3) = srcRng(r, 3)
                    .Cells(last, 4) = srcRng(r, 4)
                    .Cells(last, 5) = srcRng(r, 4)
                Else
                    If .Cells(fc.Row, 2) < srcRng(r, 3) Then .Cells(fc.Row, 2) = srcRng(r, 3)
                    If .Cells(fc.Row, 3) > srcRng(r, 3) Then .Cells(fc.Row, 3) = srcRng(r, 3)
                    If .Cells(fc.Row, 4) < srcRng(r, 4) Then .Cells(fc.Row, 4) = srcRng(r, 4)
                    If .Cells(fc.Row, 5) > srcRng(r, 4) Then .Cells(fc.Row, 5) = srcRng(r, 4)
                End If
            End With
        End If
    Next
    
End Sub

Comments

[asde]

ご丁寧に回答していただきありがとうございます。
非常に参考になる内容でした。