Excel VBA質問箱 IV

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

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


71000 / 76738 ←次へ | 前へ→

【10239】Re:デ−タ加工?
回答  ハマゾウ E-MAILWEB  - 04/1/14(水) 1:35 -

引用なし
パスワード
   ▼yukko さん:
表があるシートに以下のコードをコピーしてください。
削除したい範囲を選択後、Deleteキーで削除すればマクロが起動します。
もっと効率の良い方法があると思うのですが・・・
ご存知の方、ご指摘願います。

なお、シート名は"sheet1"としています。


Private Sub Worksheet_Change(ByVal Target As Range)
  Dim i As Long
  Dim j As Long
  Dim k As Long
  Dim Cnt As Long
  Dim Flag As Boolean
  Dim DataA(1200000) As Double
  Dim DataB(5999, 199) As Double
  Dim DataC
  ReDim DataC(6000, 200) As Double
  
  If Cells(Target.Row, Target.Column).Value <> "" Then Exit Sub
  
  DataC = Sheets("sheet1").Range("a1:GR6000").Value
  k = 1
  For j = 1 To 200
    For i = 1 To 6000
      Flag = True
      If DataC(i, j) = 0 Then
        If Sheets("sheet1").Cells(i, j) = "" Then
          Flag = False
        End If
      End If
      If Flag = True Then
        DataA(k) = DataC(i, j)
        k = k + 1
      End If
    Next i
  Next j
  Cnt = 1200000 - k + 1
  
  k = 1
  For j = 0 To 199
    For i = 0 To 5999
      DataB(i, j) = DataA(k)
      k = k + 1
    Next i
  Next j
  
  Application.EnableEvents = False
  Sheets("sheet1").Range("a1:GR6000") = DataB()
  
  i = 6001
  j = 200
  For k = 1 To Cnt
    If i = 1 Then
      i = 6000
      j = j - 1
    Else
      i = i - 1
    End If
    Sheets("sheet1").Cells(i, j) = ""
  Next k
  Application.EnableEvents = True
        
End Sub
0 hits

【10231】デ−タ加工? yukko 04/1/13(火) 21:12 質問
【10236】Re:デ−タ加工? kein 04/1/14(水) 0:23 回答
【10264】Re:デ−タ加工? yukko 04/1/14(水) 20:20 お礼
【10265】Re:デ−タ加工? yukko 04/1/14(水) 21:46 質問
【10266】Re:デ−タ加工? kein 04/1/14(水) 22:42 回答
【10268】Re:デ−タ加工? yukko 04/1/14(水) 23:41 質問
【10277】Re:デ−タ加工? kein 04/1/15(木) 13:53 回答
【10286】Re:デ−タ加工? yukko 04/1/15(木) 19:30 質問
【10288】Re:デ−タ加工? kein 04/1/15(木) 23:33 回答
【10322】Re:デ−タ加工? yukko 04/1/18(日) 20:58 質問
【10325】Re:デ−タ加工? kein 04/1/18(日) 23:21 回答
【10326】Re:デ−タ加工? yukko 04/1/19(月) 0:04 回答
【10341】Re:デ−タ加工? kein 04/1/19(月) 17:36 回答
【10343】Re:デ−タ加工? yukko 04/1/19(月) 19:09 お礼
【10239】Re:デ−タ加工? ハマゾウ 04/1/14(水) 1:35 回答
【10241】Re:デ−タ加工? ichinose 04/1/14(水) 7:46 回答
【10262】Re:デ−タ加工? ハマゾウ 04/1/14(水) 16:43 お礼

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