Преобразование столбца в строку, если ячейка не пустой

Question

Нужна помощь с помощью скрипта VBA для Excel, чтобы преобразовать данные в столбец в новую строку, если определенный столбец не пуст. Дублируйте исходные данные в нескольких первичных столбцах в новую строку и скопируйте/уплотните данные из другого столбца в эту новую строку, если ячейка в столбце не пуста. В моем файле записано 1000 записей, и у меня нет времени их индивидуально разделить. Лучше всего, если смотреть визуально ниже (извините, не хватило репутации, чтобы отправить изображение)

Начинается вот так.

Col1 ....... Col2 ..... Col3 ..... COL4
Itema ..... $ 2 .............. ...........
ItemB ..... $ 2 ........ $ 4 .............
товарC ..... $ 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 с петли записей. Просто нужно посоветовать о том, в каком месте определяется набор записей или диапазон, и как он начинается через столбцы.

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 

Там, наверное, более быстрый способ пойти об этом, что не требует первенствовать для перебора каждой ячейки в диапазоне, но это быстро и грязный и будет выполнять эту работу. Извиняюсь, если я испортил синтаксис где угодно. Я написал его на лету в блокноте.

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