将标题和行级别数据转换为列级

Question

与VBA一起工作的经验很少，所以我很难查找我想做的事情，因为我很难将所尝试的内容做成文字。 过去几天我一直在努力编写代码来完成下面的任务。

基本上我试图做的是将一组数据转换为不同的格式。

这是我的源数据看起来像。 数据：

，我需要它看起来像这样 FinalLook：

我有一个已经建立的代码是漫长的和不完整的。

第一部分

我开始与检索数据（AQ:BA）的一部分，然后将转换到格式Sheet 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