Excel VBA質問箱 IV

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

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


9855 / 76734 ←次へ | 前へ→

【72436】Re:並べ替えについて
発言  UO3  - 12/8/9(木) 20:33 -

引用なし
パスワード
   ▼マリモ さん:

元シートを上書きしますので、実行前にシートの内容は別シートにコピーしておかれたほうが
よろしいかと。
結果を別シートに転記することも、もちろんできますよ。

Sub Sample()
  Dim n As Long
  Dim v() As Variant
  Dim c As Range
  Dim x As Long
  Dim k As Long
  Dim i As Long
  
  With Sheets("Sheet1")  '元のシート
    n = WorksheetFunction.Sum(.Columns("C"))  '展開必要行数(事業所数合計)
    ReDim v(1 To n, 1 To 2)           '展開用配列初期化
    For Each c In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
      x = c.Offset(, 2).Value       '事業所の数
      For k = 1 To x
        i = i + 1
        v(i, 1) = c.Value        '町名
        v(i, 2) = c.Offset(, 1).Value  '産業の数
      Next
    Next
    .Cells.ClearContents
    .Range("A1:C1").Value = Array("ID", "町名", "産業") 'あたらしいタイトル行
    .Range("B2").Resize(UBound(v, 1), UBound(v, 2)).Value = v
    .Range("A2").Value = 1
    .Range("B2", .Range("B" & Rows.Count).End(xlUp)).Offset(, -1).DataSeries
  End With
End Sub

3 hits

【72434】並べ替えについて マリモ 12/8/9(木) 17:46 質問
【72435】Re:並べ替えについて kanabun 12/8/9(木) 20:29 発言
【72440】Re:並べ替えについて マリモ 12/8/10(金) 9:33 お礼
【72442】Re:並べ替えについて kanabun 12/8/10(金) 9:43 発言
【72443】Re:並べ替えについて マリモ 12/8/10(金) 10:26 お礼
【72436】Re:並べ替えについて UO3 12/8/9(木) 20:33 発言
【72441】Re:並べ替えについて マリモ 12/8/10(金) 9:37 お礼

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