Excel VBA質問箱 IV

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

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


48123 / 76737 ←次へ | 前へ→

【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 質問
【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 お礼

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