[[20170609163902]]　『ループ処理やり方』（らら）　ページの最後に飛ぶ

『ループ処理やり方』（らら）

教えていただけないでしょうか
下記の様に組んでいる物を
シート5枚目から7枚目まで同じ処理をしたいです
たまに　7枚目が無い時も有ります

宜しくお願いいたします

Sub 例()

Dim Idx As Long
For Idx = 5 To Sheets.Count

    If Idx = 5 Then
        Sheets(Idx).Select
Cells(1, 1).Resize(700).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Dim sheetName As String
sheetName = ActiveSheet.Name

    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Formula = sheetName

    Range("A1:A" & Range("B" & Rows.Count).End(xlUp).Row).Value = Range("A1").Value
    Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
   Range("B1").Formula = "=IF(C1=""枠"",COUNTIF(C$1:C1,C1),"""")"

   Range("A1", Cells(Rows.Count, 1).End(xlUp)).Offset(, 1).Resize(, 1).Formula = Range("B1").Formula
   Columns("B:B").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Dim r As Range
    For Each r In Range("B1", Range("B65536").End(xlUp))
        If r.Value = "" Then r.Value = r.Offset(-1, 0).Value
    Next
    Else
        Sheets(Idx).Select (False)
    End If
Next

Call わく
End Sub

＜使用 Excel：Excel2013、使用 OS：Windows10 ＞

 これでいいんじゃないですか？
　
 ＞For Idx = 5 To Sheets.Count
 　　　　　　　　　　↓
 　For Idx = 5 To Application.Min(Sheets.Count, 7)

（半平太） 2017/06/09(金) 17:09

半平太様

有難う御座いました
（らら） 2017/06/09(金) 17:15

 ＞            If Idx = 5 Then
 これシート5以外は選択するだけなんですか？
             If Idx <= 7 Then
 こういうこと？
 でもそうすると、Forで指定している意味がないような？

 少し整えてみました。
 動かしてないので、不都合あるかもしません。 
 もう一度仕様見直したほうがいいかもしれません。

    Sub 例()
        Dim Idx As Long
        Dim r As Range
        For Idx = 5 To Application.Min(Sheets.Count, 7)
            With Sheets(Idx)
                .Select
                .Cells(1, 1).Resize(700).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
                .Columns("A:B").Insert
                .Range("A1:A" & Cells(Rows.Count, "C").End(xlUp).Row).Value = .Name
                With .Range("B1:B" & Cells(Rows.Count, "A").End(xlUp).Row)
                    .Formula = "=IF(C1=""枠"",COUNTIF(C$1:C1,C1),"""")"
                    .Value = .Value
                    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C[0]"
                    .Value = .Value
                End With
            End With
        Next
        Call わく
    End Sub
（稲葉） 2017/06/09(金) 17:30

半平太様
有難う御座いました
教えてもらったやり方だと　5枚目のシート処理してくれましたけど
6枚目　7枚目　処理していただけませんでした

稲葉様
有難う御座いました
教えてもらったコードだと
5枚目の作業の中で
枠と入ってる行削除があるのですけど
削除されませんでした
6枚目　7枚目は正常に作業しました

CPU負担から　此処は

 If Idx = 5 Then
のように　一つ一つゆっくり処理させたほうが
正確に動くように感じました

本当に有難う御座います
（らら） 2017/06/09(金) 17:56

 ＞5枚目の作業の中で 
 ＞枠と入ってる行削除があるのですけど 
 ＞削除されませんでした 
 ＞6枚目　7枚目は正常に作業しました 
 行の削除は、Call わく　のことですか？
 であれば、Nextの内側に入れてください。

 ＞If Idx = 5 Then
 ＞のように　一つ一つゆっくり処理させたほうが
 ＞正確に動くように感じました
 ゆっくりも何も、それだと5枚目だけしか処理されません。
（稲葉） 2017/06/09(金) 18:11

稲葉様

コメント有難う御座います

 ＞ゆっくりも何も、それだと5枚目だけしか処理されません。

ごもっともですよね　　ですから

最大3枚なので3種類用意して動かしています

WITH　くくると　PCの負担上で作業変わってしまいました

next　内側にいれたら　WITH内処理　何もしてくれなくなりました

ただ単に　シートが一枚につながった感じになりました

PCに対しての負担が大きいのかもしれませんね

べた張りのきたない　マクロ　のほうが　安定動作って言うのが皮肉に感じます

別な部分ですが　ScreenUpdating 　入れると　エラーが出てしまったり

PCスペック依存が　強いのでしょうか

本当に有難う御座いました

（らら） 2017/06/09(金) 19:12

 勝手に書き換えただけですので、以後無視してください。
 降ります。
（稲葉） 2017/06/09(金) 19:37

 >WITH　くくると....
 >PCに対しての負担が大きいのかもしれませんね 
 何か根拠があるの？
 適当に想像してるとしか思えないけど...
（seiya） 2017/06/09(金) 19:54

コメント返信：

[ 一覧(最新更新順) ]

[[20170609163902]] 『ループ処理やり方』（らら） ページの最後に飛ぶ

[[20170609163902]]　『ループ処理やり方』（らら）　ページの最後に飛ぶ