Excel VBA質問箱 IV

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

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


48091 / 76732 ←次へ | 前へ→

【33578】Re:複雑です、、
お礼  ムーン  - 06/1/16(月) 9:07 -

引用なし
パスワード
   ▼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さん、ありがとうございました。
様々なパターンためさせて頂きます。
遅くなりました。
0 hits

【33528】複雑です、、 ムーン 06/1/14(土) 13:44 質問
【33530】Re:複雑です、、 kobasan 06/1/14(土) 16:20 回答
【33552】Re:複雑です、、 ponpon 06/1/15(日) 2:13 質問
【33553】Re:複雑です、、 kobasan 06/1/15(日) 8:43 発言
【33555】Re:複雑です、、 ponpon 06/1/15(日) 11:11 お礼
【33577】Re:複雑です、、 ムーン 06/1/16(月) 9:05 お礼
【33576】Re:複雑です、、 ムーン 06/1/16(月) 9:03 お礼
【33551】Re:複雑です、、 Hirofumi 06/1/14(土) 23:35 回答
【33578】Re:複雑です、、 ムーン 06/1/16(月) 9:07 お礼

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