не согласен в Excel

Question

Мне нужна ваша помощь в этом случае:

У меня есть:

1    11    111    Cat1 a,b,c

2    22    222    Cat2 d

3    33    333    Cat3 e,f

4    44    444    Cat4 g,h,i

и я хочу:

1    11    111    Cat1 a

1    11    111    Cat1 b

1    11    111    Cat1 c

2    22    222    Cat2 d

3    33    333    Cat3 e

3    33    333    Cat3 f

4    44    444    Cat4 g

4    44    444    Cat4 h

4    44    444    Cat4 i

Вы можете помочь мне сделать этот макрос? Я написал 5 столбцов, но мне нужен макрос для 20 столбцов, но лучше всего будет выбрать количество столбцов в макросе.

Это близко к этому случаю, но с большим количеством столбцов: Макрос Excel - столбцы с разделителями-запятыми для строк и столбцов «Совокупность»

Спасибо!

Answer 1

Вот несколько заметок.

Sub SplitRows()
strFile = Workbooks(1).FullName
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
    & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Set rss = CreateObject("ADODB.Recordset")

cn.Open strCon

strSQL = "SELECT * FROM [Sheet4$]"

rs.Open strSQL, cn

For i = 0 To rs.Fields.Count - 1
    If Not IsNumeric(rs.Fields(i)) Then
        rss.Fields.Append rs.Fields(i).Name, adVarWChar, 255
    Else
        rss.Fields.Append rs.Fields(i).Name, adInteger
    End If
Next

rss.Open

Do While Not rs.EOF
    cat = Split(rs.Fields(3), " ")
    a = Split(cat(1), ",")
    For i = 0 To UBound(a)

        rss.AddNew

        For j = 0 To rs.Fields.Count - 1
            If j = 3 Then
                rss(j) = cat(0) & " " & a(i)
            Else
                rss(j) = rs(j)
            End If
        Next

        rss.Update

    Next
    rs.MoveNext
Loop

rss.MoveFirst
Worksheets("Sheet5").Cells(2, 1).CopyFromRecordset rss

End Sub

Answer 2

Этот код должен быть тем, что вы ищете, метод ExpandData(String, String, String) принимает начальный столбец для набора данных (в данном случае «A») для первого параметра, конечный столбец для набора данных для копирования в качестве второго параметра (в данном случае «D») и, наконец, столбец с набором данных, разделенных запятой (здесь «E»).

Вы, вероятно, должны расширить его, чтобы он также занимал начальную строку или просто сделать его формулой надстройки, где он принимает диапазон и столбец.

Надеюсь, это поможет.

Sub ExpandDat()
    ExpandData "A", "D", "E"
End Sub

Sub ExpandData(start_range As String, end_range As String, comma_column As String)
    Const FirstRow = 1
    Dim LastRow As Long
    LastRow = Range(start_range & CStr(Rows.Count)).End(xlUp).Row

    ' Get the values from the worksheet '
    Dim SourceRange As Range
    Set SourceRange = Range(start_range & CStr(FirstRow) & ":" & end_range & CStr(LastRow))

    ' Get the comma seperated values as a different set of values '
    Dim CommaRange As Range
    Set CommaRange = Range(comma_column & CStr(FirstRow) & ":" & comma_column & CStr(LastRow))

    ' Get the values from the actual values '
    Dim Vals() As Variant
    Vals = SourceRange.Value

    ' We need to know the upper and lower bounds of the second dimension in the Vals Array '
    Dim lower As Integer
    Dim upper As Integer
    lower = LBound(Vals, 2)
    upper = UBound(Vals, 2)

    ' Get the comma seperated values '
    Dim Commas() As Variant
    Commas = CommaRange.Value

    ' Loop through the rows in the array and split each comma-delimited list of items and put each on its own row '
    Dim ArrIdx As Long
    Dim RowCount As Long
    For ArrIdx = LBound(Commas, 1) To UBound(Commas, 1)

        Dim CurrList As String
        CurrList = Replace(Commas(ArrIdx, 1), " ", "")

        ' Split the Comma set into an array '
        Dim ListItems() As String
        ListItems = Split(CurrList, ",")

        ' For each value in the Comma Seperated values write the output '
        Dim ListIdx As Integer
        For ListIdx = LBound(ListItems) To UBound(ListItems)
            ' Loop through the values in our source range and output them '
            For Idx = lower To upper
                Range(start_range & CStr(FirstRow + RowCount)).Offset(0, Idx - 1).Value = Vals(ArrIdx, Idx)
            Next Idx

            Range(comma_column & CStr(FirstRow + RowCount)).Value = ListItems(ListIdx)
            RowCount = RowCount + 1

        Next ListIdx

    Next ArrIdx

End Sub

Answer 3

Я не знаю много VBA, так что вам придется самому в этом разобраться. Однако я бы использовал текст в столбцы, чтобы преобразовать раздел CSV в отдельные столбцы, затем в специальную вставку с параметром транспонирования, чтобы превратить столбцы a b c в строки.