[[20160526135406]] 『空白に数式等を入力したい』(KISS) ページの最後に飛ぶ

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

 

『空白に数式等を入力したい』(KISS)

お世話様です
教えていただきたいです
お手数おかけしますが 宜しくお願い足します

下記の様に空白行を挿入しております
空白行のところに

Aの所には 全体 
CからGについては一つ下のセルの値をコピ&ペースト
2行目なら3行目の値

HからBOについては 次の行から次の空白手前までのSUMを入れたいです 

Sub 空白()
'

   Dim i As Long
 Sheets("結果").Select

  For i = Range("G" & Rows.Count).End(xlUp).Row To 3 Step -1

   If Range("G" & i).Value <> Range("G" & i - 1).Value Then

    Rows(i).Insert

   End If
  Next i
  Rows("2:2").Insert

End Sub

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


Sub main()
'A列の処理意味不明?
    For Each c In Sheets("結果").Columns("C").SpecialCells(4)
        c.Resize(, 5).Offset(1).Copy c.Resize(, 5)
    Next c
    For Each c In Sheets("結果").Columns("H").SpecialCells(4)
        r = 1
        Do
            If c.Offset(r).Value = "" Then Exit Do
            r = r + 1
        Loop
        c.Formula = "=SUM(H" & c.Row + 1 & ":H" & c.Row + r - 1 & ")"
        c.AutoFill c.Resize(, 60), 2
    Next c
End Sub
(mm) 2016/05/26(木) 15:24

mm様  有難う御座います

Aの所には  ”全体 ” テキスト入力をしたいです

For Each c In Sheets("結果").Columns("A").SpecialCells(4)

       c.Formula = "全体"
    Next c

コンパイルエラーが出てしまったため

下記の様に変数宣言した所 ループがとまらなくなりました

どの様にすればループが抜けられるのでしょうか

 Dim c As Variant

宜しくお願いいたします
(KISS) 2016/05/26(木) 16:05


Sub main()
'★「空白」を実行後に実施してください
    Dim c As Range
    For Each c In Sheets("結果").Columns("A").SpecialCells(4)
       c.Value = "全体"
    Next c

    For Each c In Sheets("結果").Columns("C").SpecialCells(4)
        c.Resize(, 5).Offset(1).Copy c.Resize(, 5)
    Next c
    For Each c In Sheets("結果").Columns("H").SpecialCells(4)
        r = 1
        Do
            If c.Offset(r).Value = "" Then Exit Do
            r = r + 1
        Loop
        c.Formula = "=SUM(H" & c.Row + 1 & ":H" & c.Row + r - 1 & ")"
        c.AutoFill c.Resize(, 60), 2
    Next c
End Sub
(mm) 2016/05/26(木) 16:13

 失礼します。
 質問そのものをよく読んでいないのですけど

 For Each c In Sheets("結果").Columns("A").SpecialCells(4) 
       c.Formula = "全体"
 Next c

 このコードが実行時エラーになる可能性はあったとしても、永久ループになることはありません。
 考えられるとすれば、A列のず〜〜っと下のほうに値があるセルがあって、空白セルの数が膨大で
 ループ処理に時間がかかっているだけだと思いますが?

(β) 2016/05/26(木) 16:23


mm様 β様

色々有難う御座います

 If c.Offset(r).Value = "" Then Exit Do

ここで たぶんとまると思うのですが
βー様におっしゃられる事を調べてみました

(A列のず〜〜っと下のほうに値があるセルがあって)

今回の集計結果だと196行
空白 マクロで225行
此処からctrl+↓  で最終行になります

マクロ実行させると
現象としましては   A列空白には 全体が記入され
CからGは普通にコピペされまして

此処から  考え中の水色の丸が 3〜5秒ほど出て

H〜  数式記入と  Aセルの  全体   が

下のほうに入力されて行きます

ここでβ様の御意見をを参考に途中でマクロを止めたら

A行全体が  1764行まで入力されているのがわかりました
何回か試すと A桁最終行は  毎回違うみたいです

このような場合  どうすればいいのでしょうか

(KISS) 2016/05/26(木) 18:11


mm様 β様

データをコピーして 別シートで試すと
ちゃんと動く事がわかりました
(KISS) 2016/05/26(木) 18:20


これで逃げる事にします
色々有難う御座いました

Sub 追加()

   Application.DisplayAlerts = False
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "work"

     Sheets("抽出").Cells.Copy Sheets("work").Range("A1")
    Sheets("抽出").Select
    Application.CutCopyMode = False
    ActiveWindow.SelectedSheets.Delete
    Sheets("work").Select
    Sheets("work").Name = "抽出"
    Range("A1").Select
   Application.DisplayAlerts = True
End Sub
(KISS) 2016/05/26(木) 18:37

コメント返信:

[ 一覧(最新更新順) ]


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