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

我在VBA上工作的经验很less，所以我很难find我想做的事情，因为我很难把我正在努力做的事情做成文字。 过去几天我一直在努力编写一个代码来完成下面的任务。

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

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

我需要它看起来像这个FinalLook：

我已经设置了一个冗长而不完整的代码。

第一部分

我开始检索数据的一部分（ AQ:BA ），然后使用下面的代码转换为sheet2中的格式。

 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