Question

我在使用VBA方面经验很少，所以我很难找到我想要做的事情，因为我很难将我想要做的事情写进去。在过去的几天里，我一直在努力编写代码来执行以下任务。

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

这就是我的源数据。数据：

我需要它看起来像这样 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

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

1 个答案: