Excel VBA를 사용한 복잡한 전치

Question

누군가가 워크 시트의 일부 데이터를 지우고 훨씬 더 조바꿈 할 수 있기를 바랍니다.

나는 여러 가지 단계를 기록하는 것에서 수백만 줄의 매우 나쁜 코드를 사용하여 매우 느린 방법을 사용하고 있지만 컴퓨터가 매번 충돌하기 때문에 빠른 방법이 필요합니다.

나는 정보가 어떻게 생겼는지, 나중에 어떻게 보이는지 샘플 문서를 첨부했습니다.

나는 두 장의 시트를 사용하여 명확하게 나타내었지만 한 장의 시트 위에서 동작하는 것이 이상적입니다. 그래도 필수는 아닙니다.

샘플에는 세 명의 회원이 있지만 실제로는 100 명이있을 수 있습니다.

나는 A18 : B20에있는 정보를 각 회원에 대해 이와 같이 따르기 위해 삭제하고자하므로 아래와 관련된 행을 삭제 한 다음 나머지 정보를 바꾸어야합니다.

• 유형
• 마지막
• 최근
통보 본

내가 지금 여기에 첨부하거나 포스트 사진 수없는 것

는 링크입니다 - 당신의 도움에 미리 http://www.filedropper.com/sample_5

감사합니다 .

Answer 1

여기서 코드를 요청하는 것은 사용자가 VBA 코딩에 대한 기본 지식이 있다는 것을 나타내므로 특정 요구에 맞게 조정할 수있는 부분적인 해결책을 제공 할 것입니다. 비판적이고 종종 부족한 요구 사항에 대한 좋은 예를 제공했습니다. 그들은 동일하지만, 그들이 독특했다면 더 좋았을 것입니다.

매크로는 워크 시트에 가지고있는 것을 재현해야합니다. 특히 데이터가 시트 "Now"의 열 A와 B에 있다고 가정하고 "After"시트에 결과를 씁니다. 그러나 당신은 아마도 약간의 연구를 통해 그것을 어떻게 바꿀 수 있는지 알아낼 수 있어야합니다. 이 코드를 일반 모듈에 넣으십시오.

Option Explicit 
Sub TransposeMemberList() 
    Dim sColHdrs() As String 
    Dim vSrc As Variant 
    Dim vRes() As Variant 
    Dim I As Long, J As Long, K As Long 
    Dim lCols As Long 
    Dim lMembers As Long 
    Dim wsSrc As Worksheet, wsRes As Worksheet 
    Dim rDest As Range 

'Set results Range First Cell 
Set wsRes = Worksheets("After") 
Set rDest = wsRes.Range("A1") 

'get Source Data 
Set wsSrc = Worksheets("Now") 
With wsSrc 
    vSrc = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Resize(columnsize:=2) 
End With 

'Assume colheaders all exist in first record 
'Col Hdr 1 = Name 
'How many columns? Count to first blank in col A 
With wsSrc.Cells.Columns(1) 
    lCols = .Find(what:="", after:=[A1], LookIn:=xlValues, _ 
         lookat:=xlWhole, searchorder:=xlByRows, _ 
         searchdirection:=xlNext).Row - 1 
End With 

'How many Members? 
'Count number of instances of first named column 
lMembers = WorksheetFunction.CountIf(wsSrc.Cells.Columns(1), vSrc(2, 1)) 

'Populate Results Array 
'First do column headers 
ReDim vRes(1 To lMembers + 1, 1 To lCols) 
vRes(1, 1) = "Name" 
For I = 2 To lCols 
    vRes(1, I) = vSrc(I, 1) 
Next I 

'Now do the columns for each memeber 
'I = Member Rows in "Now" 
'J = Member Row in "After" 
'K = Member Column 
I = 1 
For J = 1 To lMembers 
    vRes(J + 1, 1) = vSrc(I, 1) 
    For K = 2 To lCols 
     I = I + 1 
     vRes(J + 1, K) = vSrc(I, 2) 
    Next K 

    'set I to next member by checking for first column header 
    Do Until vSrc(I, 1) = vSrc(2, 1) 
     I = I + 1 
     If I > UBound(vSrc) Then Exit Do 
    Loop 
    I = I - 1 
Next J 


Set rDest = rDest.Resize(rowsize:=UBound(vRes, 1), columnsize:=UBound(vRes, 2)) 
rDest.EntireColumn.Clear 
rDest = vRes 
rDest.EntireColumn.AutoFit 


End Sub