Question

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

从这样开始。

Col1 ....... Col2 ..... Col3 ..... Col4
ItemA ..... $ 2 .........................
ItemB ..... $ 2 ........ $ 4 .............
ItemC ..... $ 6 .........................
ItemD ..... $ 2 ........ $ 3 ......... $ 5
ItemE ..... $ 9 .........................

像这样完成

Col1 ....... Col2
ItemA ..... $ 2
ItemB ..... $ 2
ItemB ..... $ 4
ItemC ..... $ 6
ItemD ..... $ 2
ItemD ..... $ 3
ItemD ..... $ 5
ItemE ..... $ 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中，我们使用Ranges而不是Recordsets。它们有点类似......但是无论如何......如果有帮助的话，你可以把它想象成一个记录集。它就像记录集中的记录/行和字段/列之间没有任何关系。

无论如何，一个如何解决这个问题的例子

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

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

2 个答案: