|
▼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
|
|