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

需要一些Excel的VBA脚本的帮助来转换列中的数据到一个新的行，如果某些列不为空。 将几个主要列中的初始数据复制到一个新行中，如果列中的单元格不为空，则将另一列中的数据复制/压缩到新行中。 我的文件有1000条logging，我没有时间单独分开。 最好，如果看到下面的video（对不起没有足够的代表张贴图像）

像这样开始

COL1 ……. col2的….. COL3 ….. COL4
意达….. $ 2 …………………….
ItemB ….. $ 2 …….. $ 4 ………….
ItemC ….. $ 6 …………………….
ItemD ….. $ 2 …….. $ 3 ……… $ 5
ItemE ….. $ 9 …………………….

像这样完成

COL1 ……. col2的
意达….. $ 2
ItemB ….. $ 2
ItemB ….. $ 4
ItemC ….. $ 6
ItemD ….. $ 2
ItemD ….. $ 3
ItemD ….. $ 5
ItemE ….. $ 9

这是我将如何处理与logging集循环的VB和HTML。 在需要logging集或范围确定的excel上需要build议，以及如何通过列开始。

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中，我们使用范围而不是logging集。 它们有些类似，但是无论如何..如果有帮助的话，你可以把它看作是一个logging集。 这只是在logging/行和字段/列之间确实没有关系，就像在logging集中那样。

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

 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

我拿你的例子数据，并创build了这个代码。 我testing了它，它工作。 我传递一个参数的行数，而不是从源表中获取。 你可以调整，如果需要使其完全dynamic。

  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