Excel VBA質問箱 IV

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

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


42555 / 76732 ←次へ | 前へ→

【39242】Re:Selection.Insert Shift:=xlDownのエ...
発言  エラー回避さん  - 06/6/20(火) 13:19 -

引用なし
パスワード
   ▼ichinose さん:
>エラー回避さん、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
>
>となります。
>試してみてください。

上記の通りです!!
ただ 既にA列に情報があり
そこから上記の結果を出したいのです
+もし可能なら作業グループ内同じ作業で
無理でしたら1Sheetごと 

目次項目1行目消し
AB列で並び替え
A列内容で上記の様に1行空け
AB列を消す

様になります。
申し訳ありません
ご伝授お願いします

4 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 発言

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