excel中的desagree

在这种情况下，我需要你的帮助：

我有：

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列的宏，但最好的是我可以选择宏中的列数

与此情况相近，但有更多列：

---

谢谢

我对VBA了解不多，所以你得自己去弄清楚。但是，我将使用文本到列来将CSV部分转换为单个列，然后使用带有转置选项的特殊粘贴来将a b c列转换为行

这里有一些注释

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

---

这段代码应该是您正在寻找的，ExpandDataString，String，String方法将数据集的起始列作为第一个参数，将要复制的数据集的结束列作为第二个参数，将数据集的结束列作为第二个参数作为第二个参数，最后是数据集的列，数据集在这里用逗号分隔

您可能应该展开它，以便它也需要一个起始行，或者只需要将它作为一个addin公式，其中需要一个范围和一个列

希望这有帮助

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

---

您当前使用的代码是什么？