將標題和行級別數據轉換爲列級

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