私は悪いVBAの人です。私を助けてください。
1つの列に3つの値を再配置し、Offsetを使用してそれらを1つの行に配置したいと思います。3行のデータを1行のデータにフラット化する必要があります。
これがコードです-それは非常に粗雑です:
Sub Macro1()
'
' Macro1 Macro
'
'turn off display update
Application.ScreenUpdating = False
Dim CVFESUMMARY2(2000, 2000)
Dim MAXROW As Integer
Dim i As Integer
Dim r As Range
Dim x As Range
Dim y As Range
Dim z As Range
Set r = Range("BJ13:BJ512")
Set x = Range("BK13:BK512")
Set y = Range("BL13:BL512")
Set z = Range("BM13:BM512")
MAXROW = 300
'format "new" columns
Range("BK11").Select
ActiveCell.FormulaR1C1 = "NORM"
Range("BL11").Select
ActiveCell.FormulaR1C1 = "MIN"
Range("BM11").Select
ActiveCell.FormulaR1C1 = "MAX"
Columns("BJ:BM").Select
Selection.ColumnWidth = 12
'define the "COPY DATA FROM" starting cell location
Sheets("CVFESUMMARY2").Select
Range("BJ13").Select
'cycle through all of the rows in range r
For i = 1 To MAXROW
'copy "BJ13"
r.Select
Selection.Copy
'paste "value only" in column "BK13"
x.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'copy "BJ13+1"
Set r = r.Offset(1, 0)
r.Select
Selection.Copy
'paste "value only" in column "BL13"
y.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'copy "BJ13+2"
Set r = r.Offset(1, 0)
r.Select
Selection.Copy
'paste "value only" in column "BM13"
z.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'move active cell to "BJ13+4"
Set r = r.Offset(2, 0)
Set x = x.Offset(4, 0)
Set y = y.Offset(4, 0)
Set z = z.Offset(4, 0)
Next i
'turn on display update
Application.ScreenUpdating = True
End Sub
これは多少機能しますが、行+2と+3に不要な値を追加しています。ループが間違っていると思います。前もって感謝します!
前
後