|
お世話になります
マリモと申します。
A列B列、C列D列・・・OT列までのペアで中には空欄もありまして
空欄は飛ばして記入のあるペアをB列c列に並べ替えをし、
その際に同じ行に書いてあったものは同じ番号をつけたいのですが、
量が多く手作業では追いつかないのでご相談させていただきました。
下記に記録例を載せます。
Sub Macro1()
'
' Macro1 Macro
'
'
Sheets("Sheet2").Select
Range("A1").Select
ActiveCell.FormulaR1C1 = "番号"
ActiveCell.Characters(1, 2).PhoneticCharacters = "バンゴウ"
Range("B1").Select
ActiveCell.FormulaR1C1 = "経度"
ActiveCell.Characters(1, 2).PhoneticCharacters = "ケイド"
Range("C1").Select
ActiveCell.FormulaR1C1 = "緯度"
ActiveCell.Characters(1, 2).PhoneticCharacters = "イド"
Range("D1").Select
Sheets("Sheet1").Select
Range("A2:B2").Select
Selection.Copy
Sheets("Sheet2").Select
Range("B2").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("C2:D2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("B3").Select
ActiveSheet.Paste
Range("A2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "1"
Range("A3").Select
ActiveCell.FormulaR1C1 = "1"
Range("B3").Select
Sheets("Sheet1").Select
Range("A3:B3").Select
Selection.Copy
Sheets("Sheet2").Select
Range("B4").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("C3:D3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("B5").Select
ActiveSheet.Paste
Range("A4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "2"
Range("A5").Select
ActiveCell.FormulaR1C1 = "2"
Range("B5").Select
Sheets("Sheet1").Select
Range("A4:B4").Select
Selection.Copy
Sheets("Sheet2").Select
Range("B6").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("C4:D4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("B7").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("E4:F4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("B8").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("G4:H4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("B9").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("I4:J4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("B10").Select
ActiveSheet.Paste
Range("A6").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "3"
Range("A6").Select
Selection.AutoFill Destination:=Range("A6:A10"), Type:=xlFillDefault
Range("A6:A10").Select
Range("C11").Select
End Sub
よろしくお願いいたします。
|
|