| |
Option Explicit
'--------------------
Sub reArrange()
'--------------------
Dim vPositions As Variant
vPositions = Array( _
"1/1", "1/2", "1/3", "1/5", "1/7", "1/8", "1/9", "1/11", "1/13", _
"2/1", "2/2", "2/3", "2/5", "2/7", "2/8", "2/9", "2/11", "2/13", _
"3/1", "3/2", "3/3", "3/5", "3/7", "3/8", "3/9", "3/11", "3/13", _
"4/1", "4/2", "4/3", "4/5", "4/7" _
)
'Dim colX As Collection: Set colX = New Collection
Dim oList As Object: Set oList = CreateObject("System.Collections.ArrayList")
Dim vRow As Variant: ReDim vRow(UBound(vPositions))
Dim j As Long
Dim rStart As Range:
Dim rX As Range
Dim vX As Variant, vY As Variant
Set rStart = Range("A9")
'-----------------------------
Do Until rStart.Value = ""
'-----------------------------
Set rX = Range(rStart, rStart.Offset(, 14)).Resize(4)
vY = rX.Value '2d Array
'-------------------------------------------
For j = LBound(vPositions) To UBound(vPositions)
'-------------------------------------------
vX = Split(vPositions(j), "/")
vRow(j) = vY(vX(0), vX(1))
Next
oList.Add vRow
Set rStart = rStart.Offset(4)
'-----------------------------
Loop
'-----------------------------
'Stop
Dim shtX As Worksheet
Set shtX = Worksheets.Add(After:=Worksheets(Worksheets.Count))
'shtX.Name = "Result"
Dim rngX As Range: Set rngX = shtX.Range("A1")
Dim vResult As Variant:
vResult = WorksheetFunction.Transpose(WorksheetFunction.Transpose(oList.toarray))
rngX.Resize(UBound(vResult, 1), UBound(vResult, 2)).Value = vResult
With rngX.CurrentRegion
.EntireColumn.AutoFit
.NumberFormat = "0"
End With
shtX.Columns("I:I").NumberFormat = "000-0000-0000"
shtX.Columns("R:R").NumberFormat = "000-0000-0000"
End Sub
|
|
엑셀에 대한 질문과
답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
