今だけ人気マンガ100円レンタル特集♪

エクセルのマクロでこんなことは出来るのでしょうか。

  A    B
1 東京  1
2 大阪  3
3 札幌  2
4 福岡  1
5 横浜  2

上記のような表をマクロの処理で下記のように書き換えることは出来るでしょうか。

  A    B
1 東京  1
2 大阪  1
3 大阪  1
4 大阪  1
5 札幌  1
6 札幌  1
7 福岡  1
8 横浜  1
9 横浜  1

B列に入ってる数字の分だけ行を作りたいのです。
(B列の数字マイナス1行を挿入する形になります)
書き換えがややこしければ、別の場所に作り直してもかまわないので
お願いします。

このQ&Aに関連する最新のQ&A

A 回答 (3件)

こんばんは。



これは、記録マクロの延長上にあると思いますから、下から取れば、簡単に出来てしまうと思います。


Sub RowsEntries()
  Dim i As Long
  Dim j As Long
  Application.ScreenUpdating = False '画面の切り替えを止める
  For i = Range("B65536").End(xlUp).Row To 1 Step -1
    j = Cells(i, 2).Value 'B列の値を取る
    If j > 1 Then
      Cells(i, 1).Resize(, 2).Copy
      Cells(i, 1).Resize(j - 1).Insert Shift:=xlDown
      Cells(i, 2).Resize(j).Value = 1
    End If
  Next i
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub
    • good
    • 0
この回答へのお礼

ありがとうございます。
御礼が遅くなって申し訳ありません。
下から上へ行く方法があるとは。
とてもシンプルで分かりやすい方法ですね。
記述の短さと分かりやすさで20pt付けさせていただきました。
また勉強しなおしてきます。

お礼日時:2007/07/09 17:41

行挿入・削除は、そのロジックを良く考えて、作らないと、自分の実行いている行や、追加すべき行を混乱するものになりがちです。


下記は、現在データの下に増加させて、現在データはそのままにして、その点の判りにくさを避けています。
Sub test01()
d = Range("A65536").End(xlUp).Row
' MsgBox d
k = d + 1
For i = 1 To d
Cells(i, "C") = i
If Cells(i, "B") = 1 Then
Else
For j = 1 To Cells(i, "B") - 1
Cells(k, "A") = Cells(i, "A")
Cells(k, "B") = 1
Cells(k, "C") = i
k = k + 1
Next j
Cells(i, "B") = 1
End If
Next i
End Sub
最下行dを求め、増やすのはその下の部分の行にして、ポンインタK
を使って1行増追加するごとにKも1足してます。
あと終了後C列でソートします。
結果
東京11
大阪12
大阪12
大阪12
札幌13
札幌13
福岡14
横浜15
横浜15
B、C列が不要なら削除。
Range("B:C").EntireColumn.Delete
をコードの最後(end SUBの直前)に入れておく。
    • good
    • 0
この回答へのお礼

ありがとうございます。
御礼が遅くなって申し訳ありません。
データを増やして並べ替えとはとても思いつきませんでした。
色々な方法があるのですね。勉強になりました。

お礼日時:2007/07/09 17:38

Sub Kakikae()


' 初期設定
Dim A() as String,B() as Integer,Counter as Integer, _
i as Integer,j as Integer,Gyou as Integer
Redim A(0),B(0)

' データの取得
Do
' B行が空の場合はループから出る
A(0)=Range("B2").Offset(Counter,0)
B(0)=Range("C2").Offset(Counter,0)
If A(0)="" Then
Exit Do
End If
' 配列の拡張
Counter=Counter+1
Redim Preserve A(Counter),B(Counter)
' データ格納
A(Counter)=A(0):B(Counter)=B(0)
DoEvents
Loop

' 書き込み
For i=1 to Counter
For j=1 to B(i)
' 行番号
Gyou=Gyou+1
Range("A1").Offset(Gyou,0)=Gyou
' A,B
Range("B1").Offset(Gyou,0)=A(i)
Range("C1").Offset(Gyou,0)=1
DoEvents
Next j
Next i
End Sub
    • good
    • 0
この回答へのお礼

ありがとうございます。
御礼が遅くなって申し訳ありません。
やってみましたが、うまく動かず、私には難しすぎました。
勉強しなおしてきます。

お礼日時:2007/07/09 17:33

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


人気Q&Aランキング