[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『空白に数式等を入力したい』(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 >
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
Aの所には ”全体 ” テキスト入力をしたいです
For Each c In Sheets("結果").Columns("A").SpecialCells(4)
c.Formula = "全体" Next c
コンパイルエラーが出てしまったため
下記の様に変数宣言した所 ループがとまらなくなりました
どの様にすればループが抜けられるのでしょうか
Dim c As Variant
宜しくお願いいたします
(KISS) 2016/05/26(木) 16:05
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
色々有難う御座います
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
データをコピーして 別シートで試すと
ちゃんと動く事がわかりました
(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.