| |
▼マリモ さん：
>まず、Sheet1の1行目を削除します。
>(2行ずつ1セットになっています。)
>Q列の1桁目を削除します。(例：3500→350)
はできているものとして、、、
これ以降、
>Sheet1E1→Sheet2B1
>Sheet1M1→Sheet2H1
>Sheet1G1(例：20110102)→Sheet2I1(23),Sheet2J1(1),Sheet2K1(2)
>Sheet1J1→Sheet2L1
>Sheet1L1→Sheet2N1
>Sheet1H1→Sheet2O1
>Sheet1K1→Sheet2P1
>Sheet1R1→Sheet2Q1
>Sheet1AB1→Sheet2R1
>Sheet1V1→Sheet2T1
>Sheet1X1→Sheet2V1
>Sheet1O1→Sheet2Z1
>Sheet1Q1→Sheet2AA1
>Sheet1Z1→Sheet2AB1
>Sheet1AF1→Sheet2AN1
>Sheet1AF2→Sheet2AO1
>Sheet1AL1→Sheet2BI1
>Sheet1AN1→Sheet2BH1
の繰り返し部分は こう書けます。
参考にしてください。
Sub Try1()
Dim c As Range, r As Range, rr As Range
Dim yy As Long
Dim ss As String
Const BH = 60
With Worksheets("Sheet1")
yy = .Cells(.Rows.Count, "AF").End(xlUp).Row
Set c = .Range("A1")
End With
With Worksheets("Sheet2")
Set rr = .Range("A1").Resize(yy \ 2, BH)
End With
For Each r In rr.Columns(1).Cells
r.Range("B1") = c.Range("E1")
r.Range("H1") = c.Range("M1")
ss = c.Range("G1").Value '(例：20110102)
r.Range("I1") = Left$(ss, 4) '-----
r.Range("J1") = Mid$(ss, 5, 2)
r.Range("K1") = Mid$(ss, 7) '-----
r.Range("L1") = c.Range("J1")
r.Range("N1") = c.Range("L1")
r.Range("O1") = c.Range("H1")
r.Range("P1") = c.Range("K1")
r.Range("Q1") = c.Range("R1")
r.Range("R1") = c.Range("AB1")
r.Range("T1") = c.Range("V1")
r.Range("V1") = c.Range("X1")
r.Range("Z1") = c.Range("O1")
r.Range("AA1") = c.Range("Q1")
r.Range("AB1") = c.Range("Z1")
r.Range("AN1") = c.Range("AF1")
r.Range("AO1") = c.Range("AF2")
r.Range("BI1") = c.Range("AL1")
r.Range("BH1") = c.Range("AN1")
Set c = c.Offset(2)
Next
End Sub
このアドレスは相対アドレスで、
たとえば Sheet1 の [B10] セルは
c が Sheet1 の[A9] であれば
c.Range("B2")
と書けることを
利用しています。
|
|
kanabun
- 13/1/24(木) 12:42 -
