|
▼マリモ さん:
提示されたコードのように、各2個のセルの転記を繰り返すと、膨大なコードになりますね。
アップされたコードでは、ペアが空白かどうかのチェックをしていませんので、それも加えると
すざましい長さのコードになりますね。
また、これはマクロ記録の宿命ですけど、Select/Selectionのてんこ盛りになります。
やはり、For/Next や Do/Loop といったループ処理が望ましいですね。
以下も、一例として。
Sub Test()
Dim x As Long
Dim i As Long
Dim j As Long
Dim v As Variant
ReDim v(1 To Rows.Count - 1, 1 To 3)
With Sheets("Sheet1")
For i = 2 To .Range("A1").CurrentRegion.Rows.Count
For j = 1 To Columns("OT").Column Step 2
If Not IsEmpty(.Cells(i, j)) Or Not IsEmpty(.Cells(i, j + 1)) Then
x = x + 1
If x > UBound(v, 1) Then
MsgBox "データが多すぎてシートに展開しきれません"
Exit Sub
End If
v(x, 1) = i - 1
v(x, 2) = .Cells(i, j).Value
v(x, 3) = .Cells(i, j + 1).Value
End If
Next
Next
End With
With Sheets("Sheet2")
.Cells.ClearContents
.Range("A1:C1").Value = Array("番号", "経度", "緯度")
.Range("A2:C2").Resize(x).Value = v
.Select
End With
End Sub
|
|