|
▼Hirofumi さん:
>こんなでも善いかも?
>
>Option Explicit
>
>Public Sub Sample()
>
> Dim i As Long
> Dim lngRows As Long
> Dim rngList As Range
> Dim vntData As Variant
> Dim vntResult As Variant
> Dim lngPos As Long
> Dim vntComp As Variant
> Dim strProm As String
>
> 'Listの左上隅セル位置を基準として設定(列見出しの最左セル位置)
> Set rngList = ActiveSheet.Cells(1, "A")
> With rngList
> 'データ行数を取得
> lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row + 1
> 'データが無い場合
> If lngRows <= 1 And .Value = "" Then
> strProm = "データが有りません"
> GoTo Wayout
> End If
> 'データを配列に取得
> vntData = .Offset(, 2).Resize(lngRows + 1, 2).Value
> End With
>
> '画面更新を停止
> Application.ScreenUpdating = False
>
> '比較用変数に比較値を代入
> vntComp = vntData(1, 1)
> '結果用変数にD列の値を代入
> vntResult = CStr(vntData(1, 2))
>
> For i = 2 To lngRows + 1
> 'もし、比較用変数と比較値が違ったら
> If vntData(i, 1) <> vntComp Then
> '結果を出力
> rngList.Offset(lngPos, 4).Value = vntResult
> '位置を保存
> lngPos = i - 1
> '比較用変数の比較値を更新
> vntComp = vntData(i, 1)
> '結果用変数にD列の値を代入
> vntResult = CStr(vntData(i, 2))
> Else
> '結果用変数にD列の値を連結
> vntResult = vntResult & CStr(vntData(i, 2))
> End If
> Next i
>
> strProm = "処理が完了しました"
>
>Wayout:
>
> '画面更新を再開
> Application.ScreenUpdating = True
>
> Set rngList = Nothing
>
> MsgBox strProm, vbInformation
>
>End Sub
hirofumiさん、ありがとうございました。
様々なパターンためさせて頂きます。
遅くなりました。
|
|