Excelマクロ作成について

質問

今作成中のマクロがありまして

　　Ａ 　Ｂ　Ｃ　Ｄ　Ｅ　Ｆ　Ｇ　Ｈ　Ｉ　Ｊ　Ｋ　Ｌ　Ｍ　Ｎ　Ｏ
　　------------------------------------------------------------
５ ｜　　　　　整理券　　
６ ｜　　　　　　NO　な　１　２　３　４　５　６　７　８
７ ｜　　１　○　な　17　　　　　　　　　　　　　
８ ｜　　２　△　　　　　17　　　　　　　　　　
９ ｜　　３　×　１　　　　　　　　　　　　　　　　
10｜　　４　□　　　21　19　17　　　　　　　　　　　　
11｜　　５　▲　２　　　　　　　　　　　　　　　　
12｜　　６　　　　　25　21　19　17　　　　　　　　　　　　
13｜　　７
14｜　　８　　　　　29　24　21　19　　　　　　　　　　
15｜　　９　　　３　　　　　　　　　　　　　　　　
16｜　　10

となっているエクセルシートなんですが、補足させていただきますと、Ａの列は空白。Ｂの列はバスが停車する順番。Ｃの列にはバス停の名前。Ｄの列は整理券の出る番号です（「な」と書いてあるのはなしという意味です）。同様にE6から右も整理券の出る番号になっています。
E7から列ごとにズラーっと書いてあるのがバスの運賃です。

実装したいのは、
(1)整理券NOをD7から下に一つずつ走査していって、もし、そのセルが空白だったら一つ上のセルをコピーして貼り付ける。何か数字またはが入力されていたらスルーする。
ということを終着バス停まで行う。

(2)(1)で出来た整理券NOとE6以降の整理券NOが対応する運賃をコピーしてＥ列に挿入し貼り付け、2番目のバス停はＦ列に対応する整理券NOの運賃表を張り付ける。3番目以降は同様にＧ、Ｈ、Ｉ、Ｊ列…とずらして貼り付けます。
という作業を(1)と同様に終着バス停の整理券NOまで行う。

というものなのですが、どうコードを書いたら良いのか初心者のため分かりません。丸投げで失礼だとは思いますが、コードをご教授いただけたらなと思います。

よろしくお願い致します。

この投稿のマルチメディアは削除されているためご覧いただけません。

回答No.7

myRange · ベストアンサー

またまた登場、myRangeです。

＞「-」を入れる方に付きましては空白のセルだけではなく
＞E7、F7、F8、G9、H10の所にも「-」が欲しいです…

なんという戯けものでせう。見落としておりました。。。(^^;;;

下記コードをコピペして実行願います。
▼▼の"-"をセットする部分を変更しました。

'------------------------------------------------------
Sub test()
　Dim myTarget As Range
　Dim myRange As Range
　Dim Rng As Range

　Dim LastRow As Long
　Dim LastColumn As Integer
　Dim R As Long
　Dim Clm As Integer

　LastRow = Cells(Rows.Count, "C").End(xlUp).Row
　LastColumn = Cells(6, Columns.Count).End(xlToLeft).Column

'---問題（１）の処理（空白セルにひとつ前の値をセット）

　Set myRange = Range("D8", Cells(LastRow, LastColumn))

　For Each Rng In myRange
　　　If Rng.Value = "" Then Rng.Value = Rng.Offset(-1).Value
　Next Rng

'---問題（２）の処理（運賃コピー）

　Set myRange = Range("E6", Cells(6, LastColumn))
　Clm = LastColumn

　For R = 7 To LastRow
　　　Set myTarget = myRange.Find(Cells(R, "D").Value, , xlValues, xlWhole)
　　　If Not myTarget Is Nothing Then
　　　　　Clm = Clm + 1
　　　　　myTarget.EntireColumn.Copy Cells(1, Clm)
　　　　　Cells(6, Clm).Value = Cells(R, "C").Value
　　　End If
　Next R

'▼▼結果の空白セルに、"-"をセット▼▼

　For R = 7 To LastRow
　　LastColumn = LastColumn + 1
　　Cells(R, LastColumn).Resize(1, Clm - LastColumn + 1).Value = "-"
　Next R

''''''元の運賃表を最後の列＋１列に移動

　　myRange.EntireColumn.Copy Cells(1, Clm + 2)
　　myRange.EntireColumn.Delete
End Sub
'------------------------------------------------------

これで最後の登場になるでしょう。
以上。

補足

myRange様、毎度どうもです。o(_ _*)o動作確認致しました。完璧です。

これで全て解決致しましたので、締め切らせて頂きます。

本当にありがとうございました。

回答No.6

myRange

またまた登場、myRangeです。

停留所名、空白セルに"ー"をセットする為には
下記の●印の４行を追加してください。

'------------------------------------------------------
Sub test()
　Dim myTarget As Range
　Dim myRange As Range
　Dim Rng As Range

　Dim LastRow As Long
　Dim LastColumn As Integer
　Dim R As Long
　Dim Clm As Integer

　LastRow = Cells(Rows.Count, "C").End(xlUp).Row
　LastColumn = Cells(6, Columns.Count).End(xlToLeft).Column

'---問題（１）の処理（空白セルにひとつ前の値をセット）

　Set myRange = Range("D8", Cells(LastRow, LastColumn))

　For Each Rng In myRange
　　　If Rng.Value = "" Then Rng.Value = Rng.Offset(-1).Value
　Next Rng

'---問題（２）の処理（運賃コピー）

　Set myRange = Range("E6", Cells(6, LastColumn))
　Clm = LastColumn

　For R = 7 To LastRow
　　　Set myTarget = myRange.Find(Cells(R, "D").Value, , xlValues, xlWhole)
　　　If Not myTarget Is Nothing Then
　　　　　Clm = Clm + 1
　　　　　myTarget.EntireColumn.Copy Cells(1, Clm)
'▼結果の空白セルに停留所名をセット▼
●　　　　Cells(6, Clm).Value = Cells(R, "C").Value
　　　End If
　Next R

'▼結果の空白セルに、"-"をセット▼
●　With Range(Cells(7, LastColumn + 1), Cells(LastRow, Clm))
●　　　.SpecialCells(xlCellTypeBlanks).Value = "-"
●　End With

''''''元の運賃表を最後の列＋１列に移動

　　myRange.EntireColumn.Copy Cells(1, Clm + 2)
　　myRange.EntireColumn.Delete
End Sub
'------------------------------------------------------

＞自分の力でも頑張ってみようと思います。

この心掛けは非常に大切なことです。
先ず、自分でやってみて、それから質問する
そうすれば習得のスピードアップが図れること間違いなし。
以上です。

補足

myRange様ありがとうございます。動作を確認しましたが、停留所の方はレイアウト図のようになりましたが、「-」を入れる方に付きましては空白のセルだけではなく、No.5の最終レイアウト図にも示したように
E7、F7、F8、G9、H10の所にも「-」が欲しいです…
　　　　Ａ　　Ｂ　　　Ｃ　　　Ｄ　　　　　Ｅ　　　Ｆ　　　Ｇ　　　Ｈ　　　　Ｉ　　　　Ｊ　　　Ｋ
　　－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
5　｜　　　　　　　　　　　整理券
6　｜　　　　　　　　　　　　NO　　　○　　　△　　　□　　　×　　　なし　　　1　　　2
7　｜　　　　1　　　○　　　なし　　　-　　　-　　　-　　　-　　　　　　17　　　
8　｜　　　　2　　　△　　　なし　　　17　　　 -　　　-　　　-　　　　　　17　　
9　｜　　　　3　　　□　　　　1　　　　19　　　19　　　-　　　-　　　　 19　　　　17
10｜　　　　 4　　　×　　　　2　　　　21　　　21　　　19　　　-　　　21　　　　19　　　17
11｜　　　　 5　　　　　　　　
12｜　　　　 6　　　　　　　　

4つの場合ですとこんな感じですが、一般的な場合ですと
E7、F8、G9、H10、I11、…（…の終わりは最終停留所の列の所まで）
という風にE7を基準に斜めに「-」を入れて、それと7行目までの間のセルは空白であろうとなかろうと「-」を埋めるというものにしたいのですが…

また、言ってる意味が不明の場合はおっしゃってください。
以上になります

回答No.5

myRange

回答３、myRangeです。

そうです。そのように質問すると回答する方も余計なことを考える必要がなくなり回答しやすくなりますよね。
ちゃんとした補足がありましたので、補足したら？と言った手前
コードもアップするのが筋というものでしょうから、一案。

'------------------------------------------------------

Sub test()
　Dim myTarget As Range
　Dim myRange As Range
　Dim Rng As Range

　Dim LastRow As Long
　Dim LastColumn As Integer
　Dim R As Long
　Dim Clm As Integer

　LastRow = Cells(Rows.Count, "C").End(xlUp).Row
　LastColumn = Cells(6, Columns.Count).End(xlToLeft).Column

'---問題（１）の処理（空白セルにひとつ前の値をセット）

　Set myRange = Range("D8", Cells(LastRow, LastColumn))

　For Each Rng In myRange
　　　If Rng.Value = "" Then Rng.Value = Rng.Offset(-1).Value
　Next Rng

'---問題（２）の処理（運賃コピー）

　Set myRange = Range("E6", Cells(6, LastColumn))
　Clm = LastColumn

　For R = 7 To LastRow
　　　Set myTarget = myRange.Find(Cells(R, "D").Value, , xlValues, xlWhole)
　　　If Not myTarget Is Nothing Then
　　　　　Clm = Clm + 1
　　　　　myTarget.EntireColumn.Copy Cells(1, Clm)
　　　End If
　Next R

''''''元の運賃表を最後の列＋１列に移動

　　myRange.EntireColumn.Copy Cells(1, Clm + 2)
　　myRange.EntireColumn.Delete
End Sub
'------------------------------------------------------

見てもらえば分かると思いますが、
列の挿入ではなく処理後に列の移動をしています。
以上です。

補足

myRange様、ありがとうございます。何とか伝わったみたいで良かったです。それ以前にもっと言葉の勉強をしなくちゃいけませんね。

動作の方確認させていただきました。こちらの方法でも質問通りの展開がすることができました。
実行すると下のようになるのですが、

　　　　Ａ　　Ｂ　　　Ｃ　　　Ｄ　　　　　Ｅ　　　Ｆ　　　Ｇ　　　Ｈ　　　　Ｉ　　　　Ｊ　　　Ｋ
　　－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
5　｜　　　　　　　　　　　整理券
6　｜　　　　　　　　　　　　NO　　　なし　　　なし　　　1　　　2　　　なし　　　1　　　2
7　｜　　　　1　　　○　　　なし　　　17　　　17　　　　　　　　　　　　17　　　
8　｜　　　　2　　　△　　　なし　　　17　　　17　　　　　　　　　　　　17　　
9　｜　　　　3　　　□　　　　1　　　　19　　　19　　　17　　　　　　　 19　　　　17
10｜　　　　 4　　　×　　　　2　　　　21　　　21　　　19　　　17　　　21　　　　19　　　17
11｜　　　　 5　　　　　　　　
12｜　　　　 6　　　　　　　　

E6～H6の所を整理券NOではなくて、停留所の名前が出力できますのでしょうか？また、(2)で出来た運賃表でE7基準として対角線上に-(半角のマイナス）を入れてそれより上のセルも同じように-を入れることは可能でしょうか？つまりこのような感じになります。

　　　　Ａ　　Ｂ　　　Ｃ　　　Ｄ　　　　　Ｅ　　　Ｆ　　　Ｇ　　　Ｈ　　　　Ｉ　　　　Ｊ　　　Ｋ
　　－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
5　｜　　　　　　　　　　　整理券
6　｜　　　　　　　　　　　　NO　　　○　　　△　　　□　　　×　　　なし　　　1　　　2
7　｜　　　　1　　　○　　　なし　　　-　　　　-　　　-　　　-　　　　　　17　　　
8　｜　　　　2　　　△　　　なし　　　17　　　 -　　　-　　　-　　　　　　17　　
9　｜　　　　3　　　□　　　　1　　　　19　　　19　　　-　　　-　　　　 19　　　　17
10｜　　　　 4　　　×　　　　2　　　　21　　　21　　　19　　　-　　　21　　　　19　　　17
11｜　　　　 5　　　　　　　　
12｜　　　　 6　　　　　　　　

お時間があればよろしくお願いします。以上です。
本当ににありがとうございました。

回答No.4

watabe007

どうでしょうか
Sub Test()
　　Dim i As Long, j As Long
　　Dim myC1 As Long, myC2 As Variant
　　Dim LastRow As Long
　　Dim Seiri As Variant

　　LastRow = Range("C7").End(xlDown).Row
　　myC1 = 5
　　For i = 7 To LastRow
　　　　If Cells(i, "D").Value <> "" Then
　　　　　　Seiri = Cells(i, "D").Value
　　　　Else
　　　　　　Cells(i, "D").Value = Seiri
　　　　End If
　　　　j = 1
　　　　Do Until Cells(i, "D").Offset(-1, j).Value = "" Or Cells(i, "D").Offset(, j).Value <> ""
　　　　　　Cells(i, "D").Offset(, j).Value = Cells(i, "D").Offset(-1, j).Value
　　　　　　j = j + 1
　　　　Loop
　　　　Range(Cells(6, myC1), Cells(LastRow, myC1)).Insert Shift:=xlToRight
　　　　myC2 = Application.Match(Cells(i, "D").Value, Rows(6), 0)
　　　　If IsError(myC2) Then
　　　　　　MsgBox "6行目に" & Cells(i, "D").Value & "が見つかりません"
　　　　　　Exit Sub
　　　　End If
　　　　Range(Cells(7, myC2), Cells(LastRow, myC2)).Copy _
　　　　　　Range(Cells(7, myC1), Cells(LastRow, myC1))
　　　　myC1 = myC1 + 1
　　Next
End Sub

補足

watabe007様毎回ありがとうございます。
動作の方確認させていただきました。
質問通りの形となりました。本当はもう少しオーダーしたいこともあるのですが、少し自分の力でも頑張ってみようと思います。

もし考えても駄目なようならまた同じカテゴリで質問させていただきますので、その時は是非、お力添えして頂ければと思う次第であります。

本当にありがとうございました。

回答No.3

myRange

質問（２）に回答が付かないのは、最初の質問の表から結果表がどういうふうに導かれるのか類推しにくいからでしょう。

例えば、最初の表の４番目の停留所を取り上げてみると

●　4　□　1　21　19　17　
■　4　□　1　21　21　19　19　17　17　17　17　

●から■がどういうふうにして導かれるのかちょと分かり難い、というようり分からない。

それから更に分かり難いところを挙げると
最初の表と結果表の６行目が全然違いますね。
また、列番号Ｑ、Ｒ、Ｓ、Ｔの部分なども。

そんなこんなで非常に分かり難いものになってます。
これではアドバイスしようがありません。

停留所番号１～１０までではなく、１～４くらいの例で
１停留所ずつの導き方を箇条書きで提示した方がいいでしょう。

以上です。

お礼

失礼かと思いますがこちらに続きを書かせていただきます。

今度はこの時D列の整理券NOはG6、H6、I6の整理券NOとそれぞれ対応していて、
3番目の停留所の整理券NOは「1」なので「1」に該当するH列の運賃表だけをコピーしてそのコピーしたものをG7に挿入。この時、元のデータは1列分挿入された事により1列分右にずれます。

最後にこの時D列の整理券NOはH6、I6、J6の整理券NOとそれぞれ対応していて、
4番目の停留所の整理券NOは「2」なので「2」に該当するJ列の運賃表だけをコピーしてそのコピーしたものをH7に挿入。この時、元のデータは1列分挿入された事により1列分右にずれます。

　　　　Ａ　　Ｂ　　　Ｃ　　　Ｄ　　　　　Ｅ　　　Ｆ　　　Ｇ　　　Ｈ　　　　Ｉ　　　　Ｊ　　　Ｋ
　　－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
5　｜　　　　　　　　　　　整理券
6　｜　　　　　　　　　　　　NO　　　　　　　　　　　　　　　　　　　　　　なし　　　1　　　2
7　｜　　　　1　　　○　　　なし　　　17　　　17　　　　　　　　　　　　17　　　
8　｜　　　　2　　　△　　　なし　　　17　　　17　　　　　　　　　　　　17　　
9　｜　　　　3　　　□　　　　1　　　　19　　　19　　　17　　　　　　　 19　　　　17
10｜　　　　 4　　　×　　　　2　　　　21　　　21　　　19　　　17　　　21　　　　19　　　17
11｜　　　　 5　　　　　　　　 2　　　　21　　　21　　　19　　　17　　　21　　　　19　　　17
12｜　　　　 6　　　　　　　　 2　　　　21　　　21　　　19　　　17　　　21　　　　19　　　17

これで4つの停留所の場合の作業が終了です。

補足

myRange様、ありがとうございます。言い回しが下手でうまく伝わって無いようですね…反省です。おっしゃる通りバス停の数が多すぎましたね。少し減らしてみます。

元データが下のようだったとします。（12行目が最終行とします）

　　　　Ａ　　Ｂ　　　Ｃ　　　Ｄ　　　　　Ｅ　　　　Ｆ　　　Ｇ
　　－－－－－－－－－－－－－－－－－－－－－
5　｜　　　　　　　　　　　整理券
6　｜　　　　　　　　　　　　NO　　　　　　　なし　　　1　　　2
7　｜　　　　1　　　○　　　なし　　　17　　　
8　｜　　　　2　　　△　　　　　　　　
9　｜　　　　3　　　□　　　　1　　　　19　　　　17
10｜　　　　 4　　　×　　　　2　　　　21　　　　19　　　17
11｜　　　　 5
12｜　　　　 6

このあとwartabe007様から頂いたコードをもとにマクロをかけると
　　　　Ａ　　Ｂ　　　Ｃ　　　Ｄ　　　　　Ｅ　　　　Ｆ　　　Ｇ
　　－－－－－－－－－－－－－－－－－－－－－
5　｜　　　　　　　　　　　整理券
6　｜　　　　　　　　　　　　NO　　　　なし　　　1　　　2
7　｜　　　　1　　　○　　　なし　　　17　　　
8　｜　　　　2　　　△　　　なし　　　17　　
9　｜　　　　3　　　□　　　　1　　　　19　　　　17
10｜　　　　 4　　　×　　　　2　　　　21　　　　19　　　17
11｜　　　　 5　　　　　　　　 2　　　　21　　　　19　　　17
12｜　　　　 6　　　　　　　　 2　　　　21　　　　19　　　17

となります。（本当は終着バス停である10行目まで表示するようにしたいのですが…）

この時D列の整理券NOはE6、F6、G6の整理券NOとそれぞれ対応していて、
1番目の停留所の整理券NOは「なし」なので「なし」に該当するE列の運賃表だけをコピーしてそのコピーしたものをE7に挿入。この時、元のデータは1列分挿入されたことにより1列分右にずれます。
　　　　Ａ　　Ｂ　　　Ｃ　　　Ｄ　　　　　Ｅ　　　Ｆ　　　　Ｇ　　　Ｈ
　　－－－－－－－－－－－－－－－－－－－－－
5　｜　　　　　　　　　　　整理券
6　｜　　　　　　　　　　　　NO　　　　　　　　なし　　　1　　　2
7　｜　　　　1　　　○　　　なし　　　17　　　17　　　
8　｜　　　　2　　　△　　　なし　　　17　　　17　　
9　｜　　　　3　　　□　　　　1　　　　19　　　19　　　　17
10｜　　　　 4　　　×　　　　2　　　　21　　　21　　　　19　　　17
11｜　　　　 5　　　　　　　　 2　　　　21　　　21　　　　19　　　17
12｜　　　　 6　　　　　　　　 2　　　　21　　　21　　　　19　　　17

今度はこの時D列の整理券NOはF6、G6、H6の整理券NOとそれぞれ対応していますので、

2番目の停留所の整理券NOも「なし」なので「なし」に該当するF列の運賃表だけをコピーしてそのコピーしたものをF7に挿入。この時、元のデータは1列分挿入された事により1列分右にずれます。
　　　　Ａ　　Ｂ　　　Ｃ　　　Ｄ　　　　　Ｅ　　　Ｆ　　　Ｇ　　　　Ｈ　　　Ｉ
　　－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
5　｜　　　　　　　　　　　整理券
6　｜　　　　　　　　　　　　NO　　　　　　　　　　　　　なし　　　1　　　2
7　｜　　　　1　　　○　　　なし　　　17　　　17　　　17　　　
8　｜　　　　2　　　△　　　なし　　　17　　　17　　　17　　
9　｜　　　　3　　　□　　　　1　　　　19　　　19　　　19　　　　17
10｜　　　　 4　　　×　　　　2　　　　21　　　21　　　21　　　　19　　　17
11｜　　　　 5　　　　　　　　 2　　　　21　　　21　　　21　　　　19　　　17
12｜　　　　 6　　　　　　　　 2　　　　21　　　21　　　21　　　　19　　　17

続きます

回答No.2

watabe007

>上の例だと終着バス停が10停留目なので10停留所分までの整理券NOを出せば良いのですが、それ以上出てしまいます。
最終行をB列で検出して処理していますので提示されているレイアウトなら16行目までしかでないはずですが
B列の16行目以降も何らかのデータがあるのですか?
(2)に関しては、最終結果をレイアウトで示していただければ他の方からも回答付くと思うのですが

補足

watabe007様度々ありがとうございます。またも説明不足で申し訳なかったです。

>最終行をB列で検出して処理していますので提示されているレイアウトなら16行目までしかでないはずですがB列の16行目以降も何らかのデータがあるのですか?

とのことですが、バスの停留所数はこの場合、10個しかないのですが、B列の16行目以降も11、12、13、…と停車番号だけは記されいます。なので停留所が書いてある所まで出したいんです。

>(2)に関しては、最終結果をレイアウトで示していただければ他の方からも回答付くと思うのですが

　　 Ａ　　Ｂ　　　Ｃ　　　Ｄ　　　　　　Ｅ　　　Ｆ　　　　Ｇ　　　　Ｈ　　　Ｉ　　　Ｊ　　　Ｋ　　　Ｌ　　　Ｍ　　　Ｎ　　　Ｏ　　　Ｐ　　　Ｑ　　　Ｒ　　　Ｓ　　　Ｔ　　　Ｕ
　 　-----------------------------------------------------------
5 ｜　　　　　　　　　　整理券
6 ｜　　　　　　　　　　　NO　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　なし　　　1　　　2　　　　3
7 ｜　　　1　　　○　　　なし　　　　　17　　　17　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　17
8 ｜　　　2　　　△　　　なし　　　　　17　　　17　　　17　　　17　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　17　　　17
9 ｜　　　3　　　×　　　　1　　　　　　17　　　17　　　17　　　17　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　17　　　17
10｜　　　4　　　□　　　　1　　　　　　21　　　21　　　19　　　19　　　17　　　17　　　17　　　17　　　　　　　　　　　　　　　　21　　　19　　　17
11｜　　　5　　　●　　　　2　　　　　　21　　　21　　　19　　　19　　　17　　　17　　　17　　　17　　　　　　　　　　　　　　　　21　　　19　　　17
12｜　　　6　　　▲　　　　2　　　　　　25　　　25　　　21　　　21　　　19　　　19　　　19　　　19　　　17　　　17　　　　　　　25　　　21　　　19　　　17
13｜　　　7　　　■　　　　2　　　　　　25　　　25　　　21　　　21　　　19　　　19　　　19　　　19　　　17　　　17　　　　　　　25　　　21　　　19　　　17
14｜　　　8　　　◎　　　　2　　　　　　29　　　29　　　24　　　24　　　21　　　21　　　21　　　21　　　19　　　19　　　　　　　29　　　24　　　21　　　19
15｜　　　9　　　▽　　　　3　　　　　　29　　　29　　　24　　　24　　　21　　　21　　　21　　　21　　　19　　　19　　　　　　　29　　　24　　　21　　　19
16｜　　　10　　 ◇　　　　3　　　　　　29　　　29　　　24　　　24　　　21　　　21　　　21　　　21　　　19　　　19　　　　　　　29　　　24　　　21　　　19
17｜　　　11
18｜　　　12
19｜　　　13

といった感じになります。

回答No.1

watabe007

>(2)(1)で出来た整理券NOとE6以降の整理券・・・
(2)の処理内容が掴めなかったのですが、こんな事かなと
Sub Test()
　　　Dim Seiri As Variant
　　　Dim LastRow As Long, i As Long, j As Long

　　　'B列の最終行
　　　LastRow = Cells(Rows.Count, "B").End(xlUp).Row
　　　Seiri = Range("D7").Value
　　　For i = 7 To LastRow
　　　　　　If Cells(i, "D").Value = "" Then
　　　　　　　　　Cells(i, "D").Value = Seiri
　　　　　　Else
　　　　　　　　　Seiri = Cells(i, "D").Value
　　　　　　End If
　　　　　　j = 1
　　　　　　Do Until Cells(i, "D").Offset(-1, j).Value = "" Or Cells(i, "D").Offset(, j).Value <> ""
　　　　　　　　　Cells(i, "D").Offset(, j).Value = Cells(i, "D").Offset(-1, j).Value
　　　　　　　　　j = j + 1
　　　　　　Loop
　　　Next
End Sub

補足

回答ありがとうございます。説明下手で申し訳ありません。

運賃表を展開するまではwatabe007さんのやり方でできました。
しかし、上の例だと終着バス停が10停留目なので10停留所分までの整理券NOを出せば良いのですが、それ以上出てしまいます。

問題の(2)についてですが、上の例で説明させていただくと、

1番目の停留所（○）は整理券NO「なし」なので、6行目の中から「なし」の列の運賃表だけのセルをコピーして、E7にそのコピーしたセルの挿入を行います。（右方向にシフトで）

次に2番目の停留所(△)も整理券NO「なし」なので6行目の中から「なし」の列の運賃表だけのセルをコピーして、F7にそのコピーしたセルの挿入を行います。（右方向にシフトで）

次に3番目の停留所(×)は整理券NO「1」なので6行目の中から「1」の列の運賃表だけのセルをコピーして、G7にそのコピーしたセルの挿入を行います。（右方向にシフトで）

この作業の繰り返しを終着バス停の10番目の停留所まで行います。

ということなんですが、どのように作成したら良いのでしょうか？またも、丸投げですいません。