ヘッダーと行レベルのデータを列レベルに変換する

Question

VBAでの作業はほとんど経験していないため、何をしようとしているのか調べるのが苦労しています。言葉にする。 私はここ数日間、以下の作業を行うコードを書くのに苦労しています。

基本的には、データのセットを別のフォーマットに変換することを試みています。

私のソースデータはこのように見えます。 データ：

と私はそれがこの FinalLookのように見える必要があります：私はすでにセットアップ長く、不完全なコードをしました

。

最初の部分

Iデータ（AQ:BA）の一部を取り出しを開始した後、以下のコードでシート2フォーマットに変換します。

Sub FirstPart() 

    Dim lastRow As Long 
    Dim Laaastrow As Long 


    Sheets("sheet2").Range("a2:A5000").ClearContents 

    lastRow = Sheets("Sheet1").Range("c" & Rows.Count).End(xlUp).Row 
    Sheets("Sheet2").Range("A2:A" & lastRow).Value = Sheets("Sheet1").Range("c5:c" & lastRow).Value 
    Sheets("Sheet2").Range("b2:l" & lastRow).Value = Sheets("Sheet1").Range("aq5:ba" & lastRow).Value 


End Sub 

しかし..私はこのコードで直面しています問題は、それはすべてのデータを引き出していることですが、私はそれがすべての値を引きたいのですが、他では空または0でないだけではありませんAQ6：BA6が空の場合、スクリプトはこの特定の行をスキップして次の行に進んでください。

第二部（最終フォーマットにSheet2のデータを変換する）

Sub NormalizeSheet() 
Dim wsSheet2 As Worksheet 
Dim wsSheet4 As Worksheet 
Dim strKey As String 
Dim clnHeader As Collection 
Dim lngColumnCounter As Long 
Dim lngRowCounterSheet2 As Long 
Dim lngRowCounterSheet4 As Long 
Dim rngCurrent As Range 
Dim varColumn As Variant 

Set wsSheet2 = ThisWorkbook.Worksheets("Sheet2") 
Set wsSheet4 = ThisWorkbook.Worksheets("Sheet4") 
Set clnHeader = New Collection 

wsSheet4.Range("c2:c5000").ClearContents 
wsSheet4.Range("e2:e5000").ClearContents 
wsSheet4.Range("g2:g5000").ClearContents 



lngColumnCounter = 2 
lngRowCounterSheet2 = 1 
Set rngCurrent = wsSheet2.Cells(lngRowCounterSheet2, lngColumnCounter) 


Do Until IsEmpty(rngCurrent.Value) 
    clnHeader.Add rngCurrent.Value, CStr(lngColumnCounter) 
    lngColumnCounter = lngColumnCounter + 1 
    Set rngCurrent = wsSheet2.Cells(lngRowCounterSheet2, lngColumnCounter) 
Loop 


lngRowCounterSheet2 = 2 
lngRowCounterSheet4 = 1 
lngColumnCounter = 1 

Do While Not IsEmpty(wsSheet2.Cells(lngRowCounterSheet2, lngColumnCounter)) 

    Set rngCurrent = wsSheet2.Cells(lngRowCounterSheet2, lngColumnCounter) 
    strKey = rngCurrent.Value 
    lngColumnCounter = 2 

    Do While Not IsEmpty(wsSheet2.Cells(lngRowCounterSheet2, lngColumnCounter)) 
     Set rngCurrent = wsSheet2.Cells(lngRowCounterSheet2, lngColumnCounter) 


     If rngCurrent.Value = "NULL" Then 

     Else 

      wsSheet4.Range("c" & lngRowCounterSheet4).Offset(1, 0).Value = strKey 
      wsSheet4.Range("e" & lngRowCounterSheet4).Offset(1, 0).Value = clnHeader(CStr(lngColumnCounter)) 
      wsSheet4.Range("g" & lngRowCounterSheet4).Offset(1, 0).Value = rngCurrent.Value 
      lngRowCounterSheet4 = lngRowCounterSheet4 + 1 
     End If 

     lngColumnCounter = lngColumnCounter + 1 
    Loop 
    lngRowCounterSheet2 = lngRowCounterSheet2 + 1 
    lngColumnCounter = 1 
Loop 



End Sub 

私はstakcoverflowにここに掲載別のスレッドからこのコードを持って、私はこの仕事を得るためにビットを変更しました。

Sheet2 B2が空の場合、コードではsheet C2が表示されず、行全体がスキップされますが、ここでは正しく表示されません。

私はこれが複雑に思えますが、私のこのアプローチは実現可能ではないかもしれません。

これを行う方法は他にありますか？データを分割して各列のセットをsheet2に移動する代わりに、単一のショットでこれを取得する方法はありますか？

Answer 1

これでどのように乗り越えてください。範囲の参照やシート名を調整する必要があります

Sub x() 

Dim r As Long, c As Range 

With Sheet1 
    For r = 5 To .Range("A" & Rows.Count).End(xlUp).Row 
     For Each c In .Range(.Cells(r, "AQ"), .Cells(r, "BK")).SpecialCells(xlCellTypeConstants) 
      If c.Value > 0 Then 
       Sheet2.Range("A" & Rows.Count).End(xlUp)(2).Value = .Range("B1").Value 
       Sheet2.Range("B" & Rows.Count).End(xlUp)(2).Value = .Cells(r, 1).Value 
       Sheet2.Range("C" & Rows.Count).End(xlUp)(2).Value = .Cells(r, 2).Value 
       Sheet2.Range("D" & Rows.Count).End(xlUp)(2).Value = .Cells(3, c.Column).Value 
       Sheet2.Range("E" & Rows.Count).End(xlUp)(2).Value = .Cells(4, c.Column).Value 
       Sheet2.Range("F" & Rows.Count).End(xlUp)(2).Value = "(blank)" 
       Sheet2.Range("G" & Rows.Count).End(xlUp)(2).Value = c.Value 
      End If 
     Next c 
    Next r 
End With 

Sheet2.Range("A1").Resize(, 7) = Array("TOPHEADER", "HEADER1", "HEADER2", "FROM", "TO", "TYPE", "UNIT") 

End Sub