Excel VBA質問箱 IV

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

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


4544 / 76733 ←次へ | 前へ→

【77809】Re:VBA素人です。至急お願いいたします。
発言  β  - 15/12/30(水) 11:49 -

引用なし
パスワード
   ▼kenkyu-sya さん:

アップ済みのコードと基本かわりませんが、処理効率を若干あっぷさせたものも参考までに。

Sub Test2()
  Dim r As Range
  Dim a As Range
  Dim f As Range
  Dim t As Range
  
  Application.ScreenUpdating = False
  
  With Range("A1").CurrentRegion
    With .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
      For Each r In .Rows
        On Error Resume Next
        Set a = r.SpecialCells(xlCellTypeConstants)
        On Error GoTo 0
        If Not a Is Nothing Then
          If a.Areas.Count > 1 Then
            Set f = a.Areas(1).Cells(1)
            Set t = a.Areas(a.Areas.Count).Cells(a.Areas(a.Areas.Count).Cells.Count)
            Range(f, t).Value = f.Value
          End If
        End If
      Next
    End With
  End With
End Sub

1 hits

【77804】VBA素人です。至急お願いいたします。 kenkyu-sya 15/12/30(水) 9:58 質問[未読]
【77805】Re:VBA素人です。至急お願いいたします。 β 15/12/30(水) 10:38 発言[未読]
【77807】Re:VBA素人です。至急お願いいたします。 kenkyu-sya 15/12/30(水) 11:10 回答[未読]
【77806】Re:VBA素人です。至急お願いいたします。 β 15/12/30(水) 10:48 発言[未読]
【77808】Re:VBA素人です。至急お願いいたします。 kenkyu-sya 15/12/30(水) 11:49 お礼[未読]
【77810】Re:VBA素人です。至急お願いいたします。 β 15/12/30(水) 12:34 発言[未読]
【77811】Re:VBA素人です。至急お願いいたします。 β 15/12/30(水) 12:36 発言[未読]
【77809】Re:VBA素人です。至急お願いいたします。 β 15/12/30(水) 11:49 発言[未読]
【77816】Re:VBA素人です。至急お願いいたします。 kenkyu-sya 15/12/30(水) 17:22 お礼[未読]

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