Question

我希望根据两个不同的列对表进行排序。

这就是我所拥有的：

| EAN | album_id | photo     |
|-----|----------|-----------|
| 111 | 123      | 64.jpg    |
| 111 | 123      | 65.jpg    |
| 222 | 123      | 64.jpg    |
| 222 | 123      | 65.jpg    |

这是理想的结果：

| EAN | album_id | photo          | primary |
|-----|----------|----------------|---------|
| 111 | 123      | 64.jpg, 65.jpg | 1       |
| 222 | 123      | 64.jpg, 65.jpg | 0       |

这是我正在使用的原始代码（我根据具体需要更改了它），到目前为止它只处理album_id和照片排序，但不处理EAN或主要列：

Sub merge()
Dim LR As Long, Delim As String

'Allow user to set the Delimiter
    Delim = Application.InputBox("Merge column B values with what delimiter?", "Delimiter", "|", Type:=2)
    If Delim = "False" Then Exit Sub
    If Delim = "" Then
        If MsgBox("You chose a blank delimiter, this will merge column B value into a single continuous string. Proceed?", _
            vbYesNo, "Merge with no delimiter") = vbNo Then Exit Sub
    End If

'Sort data
    Application.ScreenUpdating = False
    LR = Range("A" & Rows.Count).End(xlUp).Row
    Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes

'Concatenate column B values so last matching row in each group has all values
    With Range("E2:E" & LR)
        .FormulaR1C1 = "=IF(RC1=R[-1]C1, R[-1]C & " & """" & Delim & """" & " & RC2, RC2)"
        .Value = .Value
        .Copy Range("B2")
        .FormulaR1C1 = "=IF(RC1=R[1]C1, """", 1)"
        Range("E:E").AutoFilter 1, "<>1"
        .EntireRow.Delete xlShiftUp
        .EntireColumn.Clear
    End With
ActiveSheet.AutoFilterMode = False
Columns.AutoFit
Application.ScreenUpdating = True
End Sub

如何更改代码（部分或完全）以达到我正在寻找的最终结果？

非常感谢您解决此问题的任何帮助。

Answer 1

您将要删除行，所以先排序然后自下而上工作。

dim i as long, delim as string

delim = ", "

with worksheets("sheet1")
    with .cells(1, 1).currentregion
        .cells.sort Key1:=.Columns(1), Order1:=xlAscending, _
                    Key2:=.Columns(2), Order2:=xlAscending, _
                    Orientation:=xlTopToBottom, Header:=xlyes
        for i = .rows.count -1  to 2 step -1
            if .cells(i, "A").value = .cells(i+1, "A").value and _
               .cells(i, "B").value = .cells(i+1, "B").value then
                .cells(i, "C").value = .cells(i, "C").value & delim & .cells(i+1, "C").value
                .cells(i+1, "A").entirerow.delete
                .cells(i, "D").value = abs(iserror(application.match(.cells(i, "B").value, .range(.cells(1, "B"),.cells(i-1, "B")), 0)))
            end if
        next i
    end with
end with

Answer 2

您可以使用Dictionary对象和TextToColumns对象的Range方法

Option Explicit

Sub main()
    Dim cell As Range
    Dim key As Variant

    With CreateObject("Scripting.Dictionary")
        For Each cell In Range("A2", Cells(Rows.Count, 1).End(xlUp))
            .Item(cell.Value & "|" & cell.Offset(, 1).Value) = .Item(cell.Value & "|" & cell.Offset(, 1).Value) & cell.Offset(, 2).Value & " "
        Next

        Range("A1").CurrentRegion.Offset(1).Resize(Range("A1").CurrentRegion.Rows.Count - 1).Clear
        For Each key In .Keys
            Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = key
            Cells(Rows.Count, 3).End(xlUp).Offset(1).Value = Join(Split(Trim(.Item(key)), " "), ",")
        Next
        Range("A2", Cells(Rows.Count, 1).End(xlUp)).TextToColumns Range("A2"), xlDelimited, , , , , , , True, "|"
    End With
End Sub

根据两个不同的ID合并行

2 个答案: