Excel VBA質問箱 IV

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

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


8787 / 76732 ←次へ | 前へ→

【73513】Re:コードを整理したい
発言  UO3  - 13/1/17(木) 12:14 -

引用なし
パスワード
   ▼たろう さん:

こんにちは

以下のようなことですか?

Sub Sample()
  Dim lMax As Long
  Dim v() As String
  Dim c As Range
  Dim k As Long
  Dim oLvl As Long
  
  With Sheets("Sheet1")    '元シート
    With .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
      lMax = WorksheetFunction.Max(.Columns(1))
      ReDim v(1 To .Rows.Count, 1 To lMax)
      
      For Each c In .Columns(1).Cells
        If c.Value = 1 Or c.Value <= oLvl Then k = k + 1
        v(k, c.Value) = c.Offset(, 1).Value
        oLvl = c.Value
      Next
    End With
  End With
      
  With Sheets("Sheet2")    '転記シート
    .UsedRange.ClearContents
    .Range("A1").Resize(k, UBound(v, 2)).Value = v
    .Select
  End With
  
  MsgBox "転記完了です"
  
End Sub

265 hits

【73512】コードを整理したい たろう 13/1/17(木) 11:45 質問
【73513】Re:コードを整理したい UO3 13/1/17(木) 12:14 発言
【73514】Re:コードを整理したい UO3 13/1/17(木) 12:20 発言
【73516】Re:コードを整理したい たろう 13/1/17(木) 15:29 発言
【73517】Re:コードを整理したい UO3 13/1/17(木) 16:01 発言
【73518】Re:コードを整理したい たろう 13/1/17(木) 16:24 発言
【73519】Re:コードを整理したい UO3 13/1/17(木) 19:53 発言
【73520】Re:コードを整理したい UO3 13/1/17(木) 20:30 発言
【73527】Re:コードを整理したい たろう 13/1/18(金) 10:38 発言
【73528】Re:コードを整理したい UO3 13/1/18(金) 10:46 発言
【73529】Re:コードを整理したい たろう 13/1/18(金) 11:07 発言
【73530】Re:コードを整理したい UO3 13/1/18(金) 14:37 発言
【73557】Re:コードを整理したい たろう 13/1/21(月) 10:22 お礼

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