Excel VBA質問箱 IV

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

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


42731 / 76732 ←次へ | 前へ→

【39063】Re:Selection.Insert Shift:=xlDownのエ...
発言  ichinose  - 06/6/16(金) 20:21 -

引用なし
パスワード
   エラー回避さん、Jaka さん、こんばんは。

>Range("B:B").Insert Shift:=xlToRight
>Range("A1").Value = Range("A2").Value
>Range("B2:B1109").Formula = "=EXACT(A1,A2)"
>range("B1").value = "XXXXX"
>Range("B1:B1109").AutoFilter Field:=2, Criteria1:="FALSE"
>Range("B2:B1109").SpecialCells(xlCellTypeVisible).Select
>ここから下がわからないので直してない。
>「'データ消失を防ぐ為エラーRangeクラスメゾネットエラー」
たぶん、行挿入してしまうと押し出されるデータがあったからではないですか?
セルA65536に1と指定して、適当な位置で行挿入を行うと上記のエラーが
出ますね?

まあ、それ以外にも

  Selection.Insert Shift:=xlDown

このコードは問題がありそうですが・・・。


新規ブックの標準モジュールに

'=================================================================
Sub A行情報変わる位置行挿入2()
  Dim rng As Range
  Dim ans As Range
  Dim idx As Long, jdx As Long
  On Error Resume Next
  Call サンプルデータ作成
  MsgBox "A列にサンプルデータ作成"
  Range("B:B").Insert Shift:=xlToRight
  Set rng = Range("a2", Cells(Rows.Count, "a").End(xlUp))
  If rng.Row > 1 Then
    With rng
     .Offset(0, 1).Formula = "=if(row()=" & rng.Row & ","""",if(EXACT(R[-1]C[-1],RC[-1]),"""",1))"
     Set ans = .Resize(, 2).SpecialCells(xlCellTypeFormulas, xlNumbers)
     If Err.Number = 0 Then
       With ans.Areas
        For idx = .Count To 1 Step -1
          For jdx = .Item(idx).Count To 1 Step -1
            .Item(idx).Cells(jdx).EntireRow.Insert xlDown
            Next
          Next
        End With
       End If
     End With
    Range("B:B").Delete
    End If
End Sub
'====================================================================
Sub サンプルデータ作成()
  Dim idx As Long, jdx As Long
  Dim smpArray As Variant
  Dim kdx As Long
  Range("a:a").Value = ""
  kdx = 2
  smpArray = Array("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", _
           "k", "l", "m", "n", "o", "p", "q", "r", "s", "t")
  For idx = 1 To 20
    num = Int(Rnd() * 8) + 1
    For jdx = kdx To kdx + num - 1
     Cells(jdx, 1).Value = smpArray(idx - 1)
     Next jdx
    kdx = kdx + num
    Next idx
End Sub

上記のコードをコピーしてください。

何も入力されていないシートをアクティブにして
「A行情報変わる位置行挿入2」を実行してみてください。

結果としてこのコードが示すような出力がご希望の出力でしょうか?

A列の2行目から

   A
 1 
 2 a
 3 a
 4 a
 5 b
 6 b
 7 b
 8 b
 9 c
10 c
11 c
12 c
13 c
14 c
15 d
16 d
17 d

というデータが「サンプルデータ作成」で作成されたとすると、
(実際はもっとデータ数が多いです)

「A行情報変わる位置行挿入2」を実行後は、


   A
 1
 2 a
 3 a
 4 a
 5
 6 b
 7 b
 8 b
 9 b
10
11 c
12 c
13 c
14 c
15 c
16 c
17
18 d
19 d
20 d

となります。
試してみてください。

3 hits

【39047】Selection.Insert Shift:=xlDownのエラー エラー回避 06/6/16(金) 13:23 質問
【39057】Re:Selection.Insert Shift:=xlDownのエラー Jaka 06/6/16(金) 17:10 発言
【39063】Re:Selection.Insert Shift:=xlDownのエ... ichinose 06/6/16(金) 20:21 発言
【39242】Re:Selection.Insert Shift:=xlDownのエ... エラー回避さん 06/6/20(火) 13:19 発言
【39265】Re:Selection.Insert Shift:=xlDownのエ... ichinose 06/6/20(火) 18:29 発言

42731 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free