| |
'-------------------------------
Sub re_arrange_survey()
'-------------------------------
'사번 부문/본부 부서/현장 성명 직위 직책 // 사번 작성자 작성 일자 Category 내용
'부서 성명 직위 직책 작성일자 Category 내용 작성자
Dim r As Range: Set r = Worksheets(1).[A3]
Dim vTemplate As Variant
Dim X As Range
Dim colX As New Collection
'------------------------------------
Do Until r.Value = ""
'------------------------------------
vTemplate = Array( _
r.Offset(0, 2).Value, _
r.Offset(0, 3).Value, _
r.Offset(0, 4).Value, _
r.Offset(0, 5).Value, _
"일자", _
"category", _
"내용", _
"작성자" _
)
' 설문 내용 범위
Set X = r.Offset(0, 6).Resize(1, 5)
'---------------------------------------
Do Until X.Cells(1).Value = ""
'---------------------------------------
vTemplate(4) = X.Cells(3).Value
vTemplate(5) = X.Cells(4).Value
vTemplate(6) = X.Cells(5).Value
vTemplate(7) = X.Cells(2).Value
colX.Add vTemplate
Set X = X.Offset(0, 5)
Loop
Set r = r.Offset(1)
Loop
Dim shtY As Worksheet: Set shtY = Worksheets(2)
' 기존 자료 지우기
shtY.Range(shtY.[A5], shtY.[I10000]).ClearContents
Set r = shtY.[B5]
For Each v In colX
r.Resize(1, 8).Value = v
Set r = r.Offset(1)
Next
Set r = shtY.[B5]
Set r = Range(r, r.End(xlToRight).End(xlDown))
r.Sort Key1:=r.Cells(5), order1:=xlAscending, Header:=xlNo
'Stop
Set r = r.Columns(1).Offset(0, -1)
'r.Select
For i = 1 To r.Cells.Count
r.Cells(i).Value = i
Next i
End Sub
|
|
엑셀에 대한 질문과
답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
