如果单元格不为空，则将列转换为行

Question

如果某列不为空，需要一些有关 Excel 的 VBA 脚本的帮助，以便将列中的数据转换为新行。如果列中的单元格不为空，则将几个主列中的初始数据复制到新行中，并将另一列中的数据复制/压缩到该新行中。我的文件有 1,000 条记录，我没有时间单独分开它们。最好在下面看到（抱歉没有足够的代表来发布图片）

这样开始。

Col1.......Col2.....Col3.....Col4
项目A.....$2.......................
项目B.....$2........$4.......
项目 C.....$6.......................
ItemD.....$2........$3....$5
项目E.....$9.......................

这样结束

Col1.......Col2
项目A.....$2
项目 B .....$2
项目 B .....$4
项目C.....$6
ItemD .....$2
ItemD .....$3
ItemD .....$5
项目E.....$9

这就是我在 vb 和 html 中处理记录集循环的方式。只需要关于确定记录集或范围以及如何从列开始的 excel 建议。

Dim Col1, Col2, Col3, Col4, RowData, CondenseData, FinalData

FinalData = ""

While ((RS.Items__numRows <> 0) AND (NOT RS.Items.EOF))  'recordset loop how in Excel?

CondenseData = ""
Col1 = RS.Col1Data 'how to go from column to column in row in excel?
Col2 = RS.Col2Data
Col3 = RS.Col3Data
Col4 = RS.Col4Data

If Not IsNull(Col2) Then
CondenseData = Col1 & ", " & Col2
RowData = CondenseData & "<br />" ' create a new row with the revised data if not empty?
End If
If Not IsNull(Col3) Then
CondenseData = Col1 & ", " & Col3
RowData = CondenseData & "<br />"
End If
If Not IsNull(Col4) Then
CondenseData = Col1 & ", " & Col4
RowData = CondenseData & "<br />"
End If

FinalData = FinalData & RowData

  RS.Items__index=RS.Items__index+1
  RS.Items__numRows=RS.Items__numRows-1
  RS.Items.MoveNext()

Wend

Answer 1

在 VBA 中，我们使用范围而不是记录集。它们在某种程度上有点类似......但无论如何......如果有帮助的话，你可以把它想象成一个记录集。只是在记录/行和字段/列之间确实没有任何关系，就像在记录集中那样。

无论如何，一个如何去做的例子

Sub example()
    Dim rngToConvert as Range
    Dim rngRow as Range
    Dim rngCell as Range

    'write this out to a new tab so we need incrementer to keep track of rows
    Dim writeRow as integer
    writeRow = 1

    'The entire range we are converting
    Set rngToConvert = Sheets("yoursheetname").Range("A1:Z1000")

    'Loop through each row
    For each rngRow in rngToConvert.Rows

        'Loop through each cell (field)
        For each rngCell in rngRow.Cells

            'ignore that first row since that has your "ItemA", "ItemB", etc..
            'Also ignore if it doesn't have a value
            If rngCell.Column > 1 And rngCell.Value <> "" Then

                'Write that row header
                Sheets("SheetYouAreWritingOutTo").Cells(writeRow, 1).value = rngRow.Cells(1,1)

                'Write this non-null value
                Sheets("SheetYouAreWritingOutTo").Cells(writeRow, 2).value = rngCell.Value

                'Increment Counter
                writeRow = writeRow + 1 
            End if
        Next rngCell
    Next rngRow
End sub

可能有一种更快的方法来完成它，它不需要 excel 遍历范围内的每个单元格，但这又快又脏，并且可以完成这项工作。如果我在任何地方弄乱了语法，我深表歉意。我是在记事本中即时写的。

Answer 2

我采用了您的示例数据并创建了此代码。我测试了它并且它有效。我传入一个带有行数的参数，而不是从源表中获取该参数。如果需要，您可以对其进行调整以使其完全动态化。

  Sub FormatSheet(aRowCount As Integer)
      Dim iSheet2Row As Integer
    iSheet2Row = 1

    For i = 1 To aRowCount
        Dim bHasData As Boolean
        bHasData = True

        Dim iCol As Integer
        iCol = 1

        Do While bHasData
           Dim varColHeader As String

           If Len(Trim(Cells(i, iCol).Value)) > 0 Then

             If iCol = 1 Then
                  'get col header value
                  varColHeader = Cells(i, 1)
              Else
                 'write col header
                  Worksheets("Sheet2").Cells(iSheet2Row, 1).Value = varColHeader
                          'write col data
                  Worksheets("Sheet2").Cells(iSheet2Row, 2).Value = Worksheets("Sheet1").Cells(i, iCol).Value
                iSheet2Row = iSheet2Row + 1
              End If
          Else
                  bHasData = False
          End If

          iCol = iCol + 1
         Loop

    Next i

End Sub

Answer 3

以下将起作用，并且速度非常快。

Public Sub Condense(rIn As Range, rOut As Range)

    Dim v As Variant, vOut As Variant
    Dim i As Long, j As Long, c As Long

    v = rIn.Value2
    ReDim vOut(1 To UBound(v, 1) * UBound(v, 2), 1 To 2)

    For i = 1 To UBound(v, 1)
        For j = 2 To UBound(v, 2)
            If Len(v(i, j)) Then
                c = c + 1
                vOut(c, 1) = v(i, 1)
                vOut(c, 2) = v(i, j)
            End If
        Next
    Next        
    rOut.Resize(c, 2) = vOut

End Sub