Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
12628 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【9513】Findで見つけたセルの所に行を挿入したいのですが… 猛虎襲来 03/12/5(金) 22:26 質問
【9514】Re:Findで見つけたセルの所に行を挿入した... INA 03/12/5(金) 22:54 回答
【9517】Re:Findで見つけたセルの所に行を挿入した... 猛虎襲来 03/12/6(土) 0:57 質問
【9518】Re:Findで見つけたセルの所に行を挿入した... Kein 03/12/6(土) 1:06 回答
【9519】Re:Findで見つけたセルの所に行を挿入した... 猛虎襲来 03/12/6(土) 1:30 質問
【9520】Re:Findで見つけたセルの所に行を挿入した... Kein 03/12/6(土) 1:50 回答
【9523】Re:Findで見つけたセルの所に行を挿入した... 猛虎襲来 03/12/6(土) 21:14 質問
【9524】Re:Findで見つけたセルの所に行を挿入した... Kein 03/12/7(日) 0:46 回答
【9525】とうとうできました！！ 猛虎襲来 03/12/7(日) 1:28 お礼
【9513】Findで見つけたセルの所に行を挿入したい...
質問  猛虎襲来 E-MAIL  - 03/12/5(金) 22:26 -
引用なし
パスワード
   列Ａには、１〜８までの数字がランダムに入っています。
列Ａの中で、１が入力されている行に、１、２行目をコピーして貼り付けたいのです。
以下のように作ってみたのですが、１番はじめにfindで見つかった１の下に、１，２行目が数限りなく貼り付けられてしまいます。
どうしたらよいでしょう？
Msgbox　で、c.Addressを確認すると、$A$7などのaddressを参照しています。
$が気にはなるのですが、よくわかりません。
よろしくお願いします。
With Columns(1)
　　Set c = .Find(1, LookIn:=xlValues, SearchDirection:=xlPrevious)
　　If Not c Is Nothing Then
　　　　cc = c.Row
　　　　firstaddress = c.Address
　　　　Do
　　　　　　Rows("1:2").Select
　　　　　　Selection.Copy
　　　　　　Rows(cc).Select
　　　　　　Selection.Insert Shift:=xlDown
　　　　　　Set c = .FindNext(c)
　　　　Loop While Not c Is Nothing And c.Address <> firstaddress
　　End If
【9514】Re:Findで見つけたセルの所に行を挿入した...
回答  INA  - 03/12/5(金) 22:54 -
引用なし
パスワード
   Sub sample()
Dim c As Range
Dim firstaddress As String


With Columns(1)
　　Set c = .Find(1, LookIn:=xlValues, lookat:=xlWhole)

　　If c Is Nothing Then
　　　 MsgBox "見つかりませんでした。"
　　　 Exit Sub
　　End If

　　　　firstaddress = c.Address

　　　　Do
　　　　　　Rows("1:2").Copy
　　　　　　Rows(c.Row + 1).Insert Shift:=xlDown
　　　　　　
　　　　　　Set c = .FindNext(c)
　　　　　
　　　　Loop While c.Address <> firstaddress

End With
End Sub
【9517】Re:Findで見つけたセルの所に行を挿入した...
質問  猛虎襲来 E-MAIL  - 03/12/6(土) 0:57 -
引用なし
パスワード
   INAさん
ありがとうございます。作っていただいたのでやってみると、1が入力されている行の下の行に挿入されてしまいます。
挿入された結果、1のある行の上に１，２行目が来るようにしたいのですが…
【9518】Re:Findで見つけたセルの所に行を挿入した...
回答  Kein  - 03/12/6(土) 1:06 -
引用なし
パスワード
   >1のある行の上に１，２行目が
こんなコードでも出来ると思います。IV列を作業列としています。

Sub MyData_Insert()
　 Dim MyR As Range, i As Long
　
　 Application.ScreenUpdating = False
　 With Range("A3", Range("A65536").End(xlUp)).Offset(, 255)
　　　.Formula = "=IF(A3=1,1,"""")"
　　　Set MyR = .SpecialCells(3, 1).Offset(, -255)
　 End With
　 For i = MyR.Areas.Count To 1 Step -1
　　　Rows("1:2").Copy
　　　MyR.Areas(i).EntireRow.Insert xlShiftDown
　 Next i
　 Set MyR = Nothing: Columns(256).ClearContents
　 Application.ScreenUpdating = True
End Sub
【9519】Re:Findで見つけたセルの所に行を挿入した...
質問  猛虎襲来 E-MAIL  - 03/12/6(土) 1:30 -
引用なし
パスワード
   Keinさんありがとうございます。
さっそく使わせていただいたのですが、１が入力されている行のうち、行番号の一番小さい行だけに１，２行目が挿入されます。列Ａには、ほかにも１が入っているので、すべての１が入っている行にそうにゅうしたいのですが…
For ~ Next　文があるので、いくつでもできそうなのですがようくわかりません。
よろしくお願いします。
【9520】Re:Findで見つけたセルの所に行を挿入した...
回答  Kein  - 03/12/6(土) 1:50 -
引用なし
パスワード
   こちらでテストしたかぎりは、問題なく処理できましたけど・・。
もしかして一番上だけ半角数値の「1」で、それ以外は「１」になってませんか ?
それなら数式の部分を

=IF(OR(A3=1,A3=１),1,"""")"

などとしても判定できますが・・。
【9523】Re:Findで見つけたセルの所に行を挿入した...
質問  猛虎襲来 E-MAIL  - 03/12/6(土) 21:14 -
引用なし
パスワード
   Keinさん、ありがとうございます。
何度も確認したのですが、どれもみな半角です。
私は、エクセル９７なのですが、それは関係ないでしょうか？
まったく理由が思い当たりません。
【9524】Re:Findで見つけたセルの所に行を挿入した...
回答  Kein  - 03/12/7(日) 0:46 -
引用なし
パスワード
   ではこれでやってみて下さい。

Sub Test2()
　 Dim i As Long, MyR As Range
　
　 Application.ScreenUpdating = False
　 For i = Cells(65536, 1).End(xlUp).Row To 3 Step -1
　　　If Cells(i, 1).Value = 1 Then
　　　　 Rows(i & ":" & i + 1).Insert xlShiftDown
　　　End If
　 Next i
　 Set MyR = Range("A3", Range("A65536").End(xlUp)) _
　 .SpecialCells(4)
　 For i = 1 To MyR.Areas.Count
　　　Rows("1:2").Copy MyR.Areas(i).Cells(1)
　 Next i
　 Application.ScreenUpdating = True: Set MyR = Nothing
End Sub
【9525】とうとうできました！！
お礼  猛虎襲来 E-MAIL  - 03/12/7(日) 1:28 -
引用なし
パスワード
   Keinさん、ありがとうございます。
とうとうできました。
今回のは、先に空白行を作っておいて、そこに１，２行目を貼り付ける、というわけですね。
はじめに作っていただいたものがこちらでは動かなかったのが残念ですが、ともかくありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
12628 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free