Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(指定なし : 指定なし)
任意の行挿入の位置
投稿日時: 19/05/09 16:30:45
投稿者: eco2019

すみません、昨日の質問で教えて頂いた箇所なんですが、I01を検索した下に行を3行追加していただいたのですが、I01の上に行を3行追加するのはどうすればよいでしょうか?
何度も申し訳ございません。
 
  Dim rng As Range
  Dim i As Long
   
  Set rng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).Find(What:="I01", After:=Cells(Rows.Count, 1).End(xlUp))
  If Not rng Is Nothing Then
    i = rng.Row
    Do
' 動作確認の際には、下記のコメントアウトを外し確認してみましょう。
' rng.Offset(1).Resize(3).Select
      rng.Offset(1).Resize(3).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
      Set rng = rng.Offset(3)
      Set rng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).FindNext(rng)
 
    Loop While (rng.Row > i And Not rng Is Nothing)
     
  End If

回答
投稿日時: 19/05/09 17:14:08
投稿者: WinArrow
投稿者のウェブサイトに移動

最初のFINDでヒットしたときには、3行下に移動しているはず
 
参考コード
Sub Sample()
Dim MyCELL As Range
Dim FirstAdd As String
 
    With ActiveSheet
        With .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
            Set MyCELL = .Find(What:="I01", _
                LookIn:=xlFormulas, _
                LookAt:=xlPart)
            If Not MyCELL Is Nothing Then
                FirstAdd = MyCELL.Offset(3).Address
            Else
                Exit Sub
            End If
            Do
                MyCELL.Resize(3).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Set MyCELL = .FindNext(MyCELL)
            Loop Until MyCELL.Address = FirstAdd
        End With
    End With
 
End Sub
  
 
※SELECTやOFFSETを使用すると、紛らわしくなります。

投稿日時: 19/05/10 08:39:45
投稿者: eco2019

WinArrowさん、すみません。承知しました。
 
有難うございました。