Excel VBA質問箱 IV

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

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


1477 / 13646 ツリー ←次へ | 前へ→

【74178】切り抜きから貼り付け [名前なし] 13/4/26(金) 16:41 質問[未読]
【74183】Re:切り抜きから貼り付け 13/4/27(土) 6:09 発言[未読]
【74184】Re:切り抜きから貼り付け UO3 13/4/27(土) 6:35 発言[未読]
【74185】Re:切り抜きから貼り付け 13/4/27(土) 7:16 発言[未読]
【74186】Re:切り抜きから貼り付け kanabun 13/4/27(土) 10:41 発言[未読]
【74192】Re:切り抜きから貼り付け kanabun 13/4/27(土) 20:11 発言[未読]

【74178】切り抜きから貼り付け
質問  [名前なし]  - 13/4/26(金) 16:41 -

引用なし
パスワード
   i = 2
  Do While Cells(i, 1) <> ""
  If Cells(i, 21) <> "" Then
    Rows(i).Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
    Range(Cells(i, 20), Cells(i, 44)).Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range(Cells(i + 1, 20), Cells(i + 1, 44)).Cut Destination:=Range(Cells(i + 1, 15), Cells(i + 1, 39))
  End If
  i = i + 1
  Loop

上の記述だと、END if前の切り抜き→貼り付け(実際には元データのセルを左にずらしている処理)
で応答なしになってしまいます。
完全に初心者ですが、ご指摘お願いします。

【74183】Re:切り抜きから貼り付け
発言    - 13/4/27(土) 6:09 -

引用なし
パスワード
   こんにちは。

行の追加・削除をともなうループは後ろから処理するのが定石です。

まずは、うまくいかない例を説明します。
たとえば、A1:A3に「い」「ろ」「は」と入っているとします。
1行目からループして「ろ」があったら、その行をコピー挿入するとします。

すると2行目で「ろ」が見つかるので、コピー挿入。
 するとA1:A4が「い」「ろ」「ろ」「は」になる。
iに1を足して3行目をみると「ろ」があるのでコピー挿入。
 するとA1:A5が「い」「ろ」「ろ」「ろ」「は」になる。
iに1を足して4行目をみると「ろ」があるのでコピー挿入。
 するとA1:A6が「い」「ろ」「ろ」「ろ」「ろ」「は」になる。
iに1を足して5行目をみると「ろ」があるのでコピー挿入。
 するとA1:A7が「い」「ろ」「ろ」「ろ」「ろ」「ろ」「は」になる。
以下、ずーっと続く。

後ろから処理した場合は、2行の目の「ろ」を処理したら つぎは
1行目の「い」で、「該当せず」。ループ終了です。

後ろから処理しようにも最終行が分からない、と推察します。
データの最終行を調べるコードは、
Cells(i,1).End(xlDown).Row です。
(おまじない的に使わずに、コードの意味をちゃんとヘルプで調べて下さいね。
ヘルプの説明だけでは不十分と感じたらネットでも調べて下さい。)


▼[名前なし] さん:
>i = 2
>  Do While Cells(i, 1) <> ""
>  If Cells(i, 21) <> "" Then
>    Rows(i).Select
>    Selection.Copy
>    Selection.Insert Shift:=xlDown
>    Range(Cells(i, 20), Cells(i, 44)).Select
>    Application.CutCopyMode = False
>    Selection.ClearContents
>    Range(Cells(i + 1, 20), Cells(i + 1, 44)).Cut Destination:=Range(Cells(i + 1, 15), Cells(i + 1, 39))
>  End If
>  i = i + 1
>  Loop
>
>上の記述だと、END if前の切り抜き→貼り付け(実際には元データのセルを左にずらしている処理)
>で応答なしになってしまいます。
>完全に初心者ですが、ご指摘お願いします。

【74184】Re:切り抜きから貼り付け
発言  UO3  - 13/4/27(土) 6:35 -

引用なし
パスワード
   ▼[名前なし] さん:

おはようございます
エラー原因と回避策については佳さんの指摘の通りです。

なお、その場合のループ処理は Do/Loop ではなく、For/Next を使います。
Do/Loop もそうですが For/Next については、
VBAヘルプ --> Visual Basic プログラミングのヒント
ここに具体的な使用例とともに、コード例も(下から上への例も)
記載されていますので、熟読して理解した上で使いましょう。

【74185】Re:切り抜きから貼り付け
発言    - 13/4/27(土) 7:16 -

引用なし
パスワード
   こんにちは。

問題点の正確な把握は、問題解決の糸口です。
初心者であればあるほど、たいせつなところです。

重箱の隅をつつくようで恐縮ですが
本トピのタイトルが「切り抜きから貼り付け」。
「切り抜きから貼り付け」が「応答なし」に深く関わっている
とお考えになりますか?
「応答なし」になったとき、たまたまそこが処理中であった
(ように見えただけ?) という可能性はないでしょうか。

たとえば、コードから「切り抜きから貼り付け」の部分を削除したら
「応答なし」が発生しなくなるかどうか。
たとえば、ループと関係なく単発で「切り抜きから貼り付け」を実行
しても「応答なし」になるかどうか。
こういうことを確認したうえでのタイトルでしょうか。


きびしい言いかたに聞こえたらごめんなさいね。
でも、何が本当の問題なのかを ご自身が しっかり掴むことは
ご自身がコードを書くうえでとてもとても大切なんです。


▼[名前なし] さん:
>i = 2
>  Do While Cells(i, 1) <> ""
>  If Cells(i, 21) <> "" Then
>    Rows(i).Select
>    Selection.Copy
>    Selection.Insert Shift:=xlDown
>    Range(Cells(i, 20), Cells(i, 44)).Select
>    Application.CutCopyMode = False
>    Selection.ClearContents
>    Range(Cells(i + 1, 20), Cells(i + 1, 44)).Cut Destination:=Range(Cells(i + 1, 15), Cells(i + 1, 39))
>  End If
>  i = i + 1
>  Loop
>
>上の記述だと、END if前の切り抜き→貼り付け(実際には元データのセルを左にずらしている処理)
>で応答なしになってしまいます。
>完全に初心者ですが、ご指摘お願いします。

【74186】Re:切り抜きから貼り付け
発言  kanabun  - 13/4/27(土) 10:41 -

引用なし
パスワード
   ▼[名前なし] さん:

よこから失礼します。

ご提示のコードより、
1. 無駄な Select Selection を取る
2. 範囲を読みやすくする↓
 たとえば
> Range(Cells(i, 20), Cells(i, 44))

 Cells(i, 20).Resize(, 25)
のように Resizeを使って表現する
と、
Sub QQ2()
のようになります。これ上から処理していってるわけですね。

Sub QQ2()
 Dim i&
 i = 2
  Do While Len(Cells(i, 1).Value) > 0
    If Len(Cells(i, 21).Value) > 0 Then
      Rows(i).Copy
      Rows(i).Insert
      Cells(i, 20).Resize(, 25).ClearContents
      Cells(i + 1, 20).Resize(, 25).Cut _
        Destination:=Cells(i + 1, 15)
      i = i + 1 '★追加
    End If
    i = i + 1
  Loop

End Sub

いっぽう、下からFor〜Nextで処理しようとすると
一例としてつぎのようになるかと思います。

Sub QQ3()
  Dim i As Long
  Dim iLast As Long
  
  iLast = Cells(Rows.Count, 1).End(xlUp).Row
  For i = iLast To 2 Step -1
    If Not IsEmpty(Cells(i, 21).Value) Then
      Rows(i).Copy
      Rows(i).Insert
      With Cells(i, 20).Resize(, 25)
        .ClearContents
        .Offset(1).Cut Cells(i + 1, 15)
      End With
    End If
  Next
End Sub

で、上から(QQ2) でも 下から(QQ3) でも、こういう一行づつ
処理していたのでは画面がチラチラしてあまり処理効率がよくないと
思います。


分らないのは、

>      Rows(i).Copy
>      Rows(i).Insert

で同じ行を複製しているので、A列から N列? までのデータが
ダブルになりますけど?

これは ほんとうは どういうことをしたかったんでしょう。
それを再確認してから、手段を考えても遅くはないと思いますが。

ある範囲のデータを一行おきに移動したかったんですか?
一行おきに空白行を入れたいときは ソートを使う方法もありますよ。

【74192】Re:切り抜きから貼り付け
発言  kanabun  - 13/4/27(土) 20:11 -

引用なし
パスワード
   > 一行おきに空白行を入れたいときは ソートを使う方法もありますよ。

この方法の参考サンプルです。
T列から25列分のデータを
O列から25列の位置へ移動し、1行おきに空行を挿入します。
(A列のほうはいじらないので元のままです)

Sub Try1() '移動して2行化
  Dim r As Range
  Dim v
  Dim i&
  Dim yy&
  Const xx = 25 '移動するデータ列数
  yy = Cells(Rows.Count, 1).End(xlUp).Row - 1
  Set r = Range("T2").Resize(yy + yy, xx)
  v = r.Resize(, xx + 1).Value
  r.ClearContents
  For i = 1 To yy
    If Not IsEmpty(v(i, 2)) Then
      v(i, xx + 1) = i
      v(i + yy, xx + 1) = i
    End If
  Next
  Set r = Range("O2").Resize(yy + yy, xx + 1)
  r.Value = v
  r.Sort Key1:=r.Columns(xx + 1), Header:=xlNo
  r.Columns(xx + 1).Clear
End Sub

Excelのソートは速いので、
1000行くらいなら たぶん一瞬だと思います。

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