[[20161023193346]] 『シートループがうまくいかない』(まこと) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『シートループがうまくいかない』(まこと)

Sub 内訳書整理()

    Dim gyoP, gyoR
    Dim sh1
    gyoP = 3
    For gyoP = 3 To 33
       For sh1 = 1 To 8
            For gyoR = 4 To 33
                Worksheets("R" & sh1).Range("C" & gyoR & ":" & "E" & gyoR).Value = Worksheets("内訳書P").Range("B" & gyoP & ":" & "D" & gyoP).Value
                gyoP = gyoP + 1
            Next
        Next
    Next
End Sub

「内訳書P」というシートから31行ごとに「R1」〜「R8」というシートに
転記しようとしています。
「R1」〜「R8」へはシートループしているようなんですが「R2」〜「R8」
のシートにおいて3行目からの転記ができません。
上に空白行が入ってしまいます。
内訳書Pは、A行に1〜31の番号が振っているのでそれを利用したいと
思うのですがうまくいきません。
また、31行めいいっぱい入っているのではなくキリの良いとこで切って
あるのでそのシートによって2行空いていたり5行空いていたりと
色々です。
どうすればうまく動きますか?

< 使用 Excel:Excel2013、使用 OS:Windows7 >


 ちょっとよく分からないですが、

 >For gyoR = 4 To 33

 4行から始めているんですから、3行目から書く訳ないですよね。

 何故 For gyoR = 3 To 33 にしないんですか?
                ↑

(半平太) 2016/10/23(日) 20:01


 私もよくわかりませんが、
    For sh1 = 1 To 8
        Worksheets("R" & sh1).Range("C4:E4").Resize(31).Value = Worksheets("内訳書P").Range("B3:D3").Resize(31).Value
    Next
 といったことなんでしょうか。

(γ) 2016/10/23(日) 20:11


Worksheets("内訳書P")は、3行目をR1」の4行目へ転記してます。
「R1」は、動作問題ないです。
「R2」を、転記しようとすると上に空白ができてしまい5行目から転記されます。
(まこと) 2016/10/23(日) 20:31

希望の動作は、こんなことでしょうか。

1)内訳書Pの3〜33行を、R1の4〜34行目に転記
2)内訳書Pの34〜64行を、R2の4〜34行目に転記
3)内訳書Pの65〜95行を、R3の4〜34行目に転記
4)以下、省略

(マナ) 2016/10/23(日) 20:49


あ、そうですよね。私のは、ちょっとというか大分雑な回答でしたね。
私のコードに少し手を入れるとできはしますが、
コードを示すのはやめておきます。蟄居します。

(γ) 2016/10/23(日) 21:08


ども^^
元の表はこういうことですかねぇ?

        [A]   [B]   [C]   [D]   
      ┌──┬──┬──┬──┐
  [4] │ 1  │ あ │ あ │ あ │
      ├──┼──┼──┼──┤
  [5] │ 2  │ あ │ あ │ あ │
      ├──┼──┼──┼──┤
  [6] │ 3  │ あ │ あ │ あ │
      ├──┼──┼──┼──┤
  [7] │ 4  │ あ │ あ │ あ │
      ├──┼──┼──┼──┤
  [8] │ 5  │ あ │ あ │ あ │
      ├──┼──┼──┼──┤
  [9] │ 6  │ あ │ あ │ あ │
      ├──┼──┼──┼──┤
  [10]│ 7  │ あ │ あ │ あ │
      ├──┼──┼──┼──┤
  [11]│ 8  │ あ │ あ │ あ │
      ├──┼──┼──┼──┤
  [12]│ 1  │ い │ い │ い │
      ├──┼──┼──┼──┤
  [13]│ 2  │ い │ い │ い │
      ├──┼──┼──┼──┤
  [14]│ 3  │ い │ い │ い │
      ├──┼──┼──┼──┤
  [15]│ 4  │ い │ い │ い │
      ├──┼──┼──┼──┤
  [16]│ 5  │ い │ い │ い │
      ├──┼──┼──┼──┤
  [17]│ 6  │ い │ い │ い │
      ├──┼──┼──┼──┤
  [18]│ 7  │ い │ い │ い │
      ├──┼──┼──┼──┤
  [19]│ 8  │ い │ い │ い │
      ├──┼──┼──┼──┤
  [20]│ 9  │ い │ い │ い │
      ├──┼──┼──┼──┤
  [21]│ 10 │ い │ い │ い │
      └──┴──┴──┴──┘

1が出てきたら次のシートに転記先が変わる?

(まっつわん) 2016/10/24(月) 13:00


まっつわん様

はい!そんなイメージで作成したいと思っています。
でも、コードが思い浮かばず・・・
午前中、修正していて「動いたぁ〜」と思ったらエラーして全て消えてしまいました。
よって、修正する気力を失ってしまったので修正はまた明日にしようと思います。
(↑必要になるのはたぶん来年1月?)
(まこと) 2016/10/24(月) 14:52


>>1が出てきたら次のシートに転記先が変わる?
>はい!そんなイメージで作成したいと思っています。

なら、流れ的には

プログラム始め
  dim i as long 'シートの番号
  dim n as long '書き出しの行番号

    dim m as long '読み取る行番号

元シートのA列をm行目からデータ終わりの行まで順に繰り返し
  もし値が1ならそのときは
    i = i +1 '次のシートの番号に変更
    n = 1 '行番号初期化

    そうでなければ
    n = n + 1 '次の書き出し行番号
  end if
  書き出しシート(i).cells(n,"C").value=元のシート.cells(m,"B").value
次へ
プログラム終わり

こんな感じじゃないですかね?

>修正はまた明日にしようと思います。
がんばってください^^

(まっつわん) 2016/10/24(月) 15:23


Sub 内訳書転記()
    Dim i As Long
    Dim n As Long
    Dim m As Long
    Dim WSP
    i = 1
    n = 4
    Set WSP = Worksheets("内訳書P")
    Worksheets("R1").Range("C4:E4").Value = WSP.Range("B3:D3").Value
    For m = 4 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(m, "A") = 1 Then
            i = i + 1
            n = 4
        Else
            n = n + 1
        End If
        Worksheets("R" & i).Range(Cells(n, "C"), Cells(n, "E")).Value = WSP.Range(Cells(m, "B"), Cells(m, "D")).Value
    Next
End Sub

上手くいったと思っていたらオブジェクトエラーで行き詰ってしまいました。
どこが、ちがうのでしょうか?

Worksheets("R" & i).Range(Cells(n, "C"), Cells(n, "E")).Value = WSP.Range(Cells(m, "B"), Cells(m, "D")).Value
↑ デバッグするとここが黄色くなります。
(まこと) 2016/10/26(水) 08:44


 こう云うのはよくあるトラブルなんですけど

 >Worksheets("R" & i).Range(Cells(n, "C"), Cells(n, "E")).Value = WSP.Range(Cells(m, "B"), Cells(m, "D")).Value 
               ~~~↑~~~   ~~~↑~~~~            ~~↑~~     ~~~↑~~~

 これらのCellsの親(シート名)が状況依存になっているんです。

 チャンと親を修飾するか、こんな文字指定でやるかですね。
              ↓
 Worksheets("R" & i).Range("C" & n).Resize(1, 3).Value = WSP.Range("B" & m).Resize(1, 3).Value

(半平太) 2016/10/26(水) 09:50


半平太様

上手くいきました!
ありがとうございます!

まっつわん様

完成しました!
ありがとうございます!
(まこと) 2016/10/27(木) 00:12


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.