| |
▼マリモ さん：
マクロ記録をマクロにするときの参考にしてください
Select , Selection を使ったマクロの記録のままは、とっても読みにくい。
ので、マクロ記録の最初の方だけですけど、Select Selection をとってみると
以下のようです。
Sub Macro1M()
'
Sheets("Sheet2").Range("A1:C1").Value = Array("番号", "経度", "緯度")
'(1行目)
Sheets("Sheet1").Range("A2:B2").Copy Sheets("Sheet2").Range("B2")
Sheets("Sheet1").Range("C2:D2").Copy Sheets("Sheet2").Range("B3")
Sheets("Sheet2").Range("A2:A3").Value = 1
'(2行目)
Sheets("Sheet1").Range("A3:B3").Copy Sheets("Sheet2").Range("B4")
Sheets("Sheet1").Range("C3:D3").Copy Sheets("Sheet2").Range("B5")
Sheets("Sheet2").Range("A4:A5").Value = 2
'(以下同様)
End Sub
このまとめたものをみながら、２重ループで
・外側 ２行目から 最下行まで ループ
・内側 1列目から 最終列まで ２列づつ
の構文に直してみました。
Sub MMcopy()
Dim i As Long, j As Long 'コピー元行、列番号
Dim n As Long, m As Long 'コピー元 最終行、最終列番号
Dim y As Long, y1 As Long 'コピー先行番号
Dim k As Long 'コピー先連番用
Dim COP As Boolean
Dim r As Range
With Sheets("Sheet2")
.UsedRange.Clear
.Range("A1:C1").Value = Array("番号", "経度", "緯度")
Set r = .Range("A1") 'コピー先シート先頭セル
End With
With Sheets("Sheet1")
With .Range("A1").CurrentRegion
n = .Rows.Count
m = .Columns.Count
End With
y = 1
For i = 2 To n
For j = 1 To m Step 2
If Not IsEmpty(.Cells(i, j).Value) Then
y = y + 1
If Not COP Then COP = True: y1 = y
r(y, 2).Resize(, 2) = .Cells(i, j).Resize(, 2).Value
End If
Next
If COP Then
k = k + 1
r(y1, 1).Resize(y - y1 + 1).Value = i - 1
End If
COP = False
Next
End With
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
