Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

48193 / 76807

←次へ　｜　前へ→


	【33551】Re:複雑です、、

Hirofumi - 06/1/14(土) 23:35 -


	引用なし

	パスワード

こんなでも善いかも？

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

0 hits

▼

【33528】複雑です、、 ムーン 06/1/14(土) 13:44