Объединить значения на основе нескольких критериев

Используя следующий фрагмент, вы можете делать похожие вещи довольно легко, например:

ajax.get('/test.php', {foo: 'bar'}, function() {});

Вот фрагмент:

var ajax = {};
ajax.x = function () {
    if (typeof XMLHttpRequest !== 'undefined') {
        return new XMLHttpRequest();
    }
    var versions = [
        "MSXML2.XmlHttp.6.0",
        "MSXML2.XmlHttp.5.0",
        "MSXML2.XmlHttp.4.0",
        "MSXML2.XmlHttp.3.0",
        "MSXML2.XmlHttp.2.0",
        "Microsoft.XmlHttp"
    ];

    var xhr;
    for (var i = 0; i < versions.length; i++) {
        try {
            xhr = new ActiveXObject(versions[i]);
            break;
        } catch (e) {
        }
    }
    return xhr;
};

ajax.send = function (url, callback, method, data, async) {
    if (async === undefined) {
        async = true;
    }
    var x = ajax.x();
    x.open(method, url, async);
    x.onreadystatechange = function () {
        if (x.readyState == 4) {
            callback(x.responseText)
        }
    };
    if (method == 'POST') {
        x.setRequestHeader('Content-type', 'application/x-www-form-urlencoded');
    }
    x.send(data)
};

ajax.get = function (url, data, callback, async) {
    var query = [];
    for (var key in data) {
        query.push(encodeURIComponent(key) + '=' + encodeURIComponent(data[key]));
    }
    ajax.send(url + (query.length ? '?' + query.join('&') : ''), callback, 'GET', null, async)
};

ajax.post = function (url, data, callback, async) {
    var query = [];
    for (var key in data) {
        query.push(encodeURIComponent(key) + '=' + encodeURIComponent(data[key]));
    }
    ajax.send(url, callback, 'POST', query.join('&'), async)
};
0
задан m8_ 15 January 2019 в 19:51
поделиться

2 ответа

Это довольно многословное решение, предполагающее, что ваши данные точно такие же, как вы опубликовали (а также на листе 1), но это работает (я думаю). Вам также нужно будет создать второй лист для выходных данных. Дайте мне знать, если вы не уверены, где разместить этот код / ​​как его запустить.

Sub DoStuff()
    'Initialize the output sheet
    Sheet2.Cells.Clear
    Sheet2.Cells(1, 1) = "Order ID"
    Sheet2.Cells(1, 2) = "ID"
    Sheet2.Cells(1, 3) = "TRUE"
    Sheet2.Cells(1, 4) = "FALSE"
    newRow = 2

    'Loop through the first sheet and remove duplicates
    lastRow = Sheet1.Range("E:E").Cells.SpecialCells(xlCellTypeConstants).Count
    For i = 2 To lastRow
        exists = False
        For j = 2 To newRow
            If Sheet1.Cells(i, 5).Value = Sheet2.Cells(j, 1).Value Then
                exists = True
                Exit For
            End If
        Next
        If exists = False Then
            Sheet2.Cells(newRow, 1) = Sheet1.Cells(i, 5).Value
            Sheet2.Cells(newRow, 2) = Sheet1.Cells(i, 2).Value
            'Populate the true and false columns
            For k = 2 To lastRow
                If Sheet1.Cells(k, 5).Value = Sheet1.Cells(i, 5).Value Then
                    If Sheet1.Cells(k, 3).Value = True And Sheet1.Cells(k, 4).Value = True Then
                        Sheet2.Cells(newRow, 3) = Sheet2.Cells(newRow, 3).Value & Sheet1.Cells(k, 1).Value & ", "
                    Else
                        Sheet2.Cells(newRow, 4) = Sheet2.Cells(newRow, 4).Value & Sheet1.Cells(k, 1).Value & ", "
                    End If
                End If
            Next
            'Remove extra characters, if there are any
            If Sheet2.Cells(newRow, 3).Value <> "" Then
                Sheet2.Cells(newRow, 3).Value = Left(Sheet2.Cells(newRow, 3).Value, Len(Sheet2.Cells(newRow, 3).Value) - 2)
            End If
            If Sheet2.Cells(newRow, 4).Value <> "" Then
                Sheet2.Cells(newRow, 4).Value = Left(Sheet2.Cells(newRow, 4).Value, Len(Sheet2.Cells(newRow, 4).Value) - 2)
            End If
            newRow = newRow + 1
        End If
    Next
End Sub

Результаты с использованием ваших данных, как опубликовано:

enter image description here

0
ответ дан Ron Rosenfeld 15 January 2019 в 19:51
поделиться

Я использовал словарь и модуль Class, чтобы помочь собрать и преобразовать данные. Он также имеет преимущество в том, что за ним легче следить и поддерживать, поскольку названные параметры более или менее очевидны.

Я также «выполнил работу» в массиве VBA, так как с любой крупной базой данных скорость выполнения будет значительно выше.

В коде должно быть очевидно, где определить рабочие таблицы и диапазоны, которые вы хотите использовать для своих исходных данных и результатов

Обычный модуль

<час>
Option Explicit
'Set reference to Microsoft Scripting Runtime
Sub orgOrders()
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
    Dim vSrc As Variant, vRes As Variant
    Dim dOrds As Dictionary, cOrd As cOrder
    Dim I As Long, V As Variant
    Dim sKey As String

'set source and result worksheet and range
Set wsSrc = Worksheets("Sheet2")
Set wsRes = Worksheets("Sheet2")
    Set rRes = wsRes.Cells(1, 10)

'read source data into array
With wsSrc
    vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 5).End(xlUp))
End With

'Read into order dictionary
Set dOrds = New Dictionary
For I = 2 To UBound(vSrc, 1)
    Set cOrd = New cOrder
    sKey = vSrc(I, 5) 'Order ID
    With cOrd
        .ID = vSrc(I, 2)
        .Key = vSrc(I, 1)
        .Status1 = vSrc(I, 3)
        .Status2 = vSrc(I, 4)
        .addTrueFalse .Key, .Status1, .Status2

    If Not dOrds.Exists(sKey) Then
        dOrds.Add Key:=sKey, Item:=cOrd
    Else
        dOrds(sKey).addTrueFalse .Key, .Status1, .Status2
    End If

    End With
Next I

'Dim Results array
ReDim vRes(0 To dOrds.Count, 1 To 4)

'Headers
    vRes(0, 1) = "Order ID"
    vRes(0, 2) = "ID"
    vRes(0, 3) = "TRUE"
    vRes(0, 4) = "FALSE"

'Data
I = 0
For Each V In dOrds.Keys
    I = I + 1
    With dOrds(V)
        vRes(I, 1) = V
        vRes(I, 2) = .ID
        vRes(I, 3) = .TrueFalse(True)
        vRes(I, 4) = .TrueFalse(False)
    End With
Next V

'Write results
Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2))
With rRes
    .EntireColumn.Clear
    .Value = vRes
    .Rows(1).Font.Bold = True
    With .EntireColumn
        .HorizontalAlignment = xlCenter
        .AutoFit
    End With
End With

End Sub

Модуль класса [ 114]

ПЕРЕИМЕНОВАТЬ этот модуль cOrder


Option Explicit
Private pKey As Long
Private pID As String
Private pStatus1 As Boolean
Private pStatus2 As Boolean
Private pTrueFalse As Dictionary

Public Property Get Key() As Long
    Key = pKey
End Property
Public Property Let Key(Value As Long)
    pKey = Value
End Property

Public Property Get ID() As String
    ID = pID
End Property
Public Property Let ID(Value As String)
    pID = Value
End Property

Public Property Get Status1() As Boolean
    Status1 = pStatus1
End Property
Public Property Let Status1(Value As Boolean)
    pStatus1 = Value
End Property

Public Property Get Status2() As Boolean
    Status2 = pStatus2
End Property
Public Property Let Status2(Value As Boolean)
    pStatus2 = Value
End Property

Public Function addTrueFalse(Key As Long, Status1 As Boolean, Status2 As Boolean)
        If Status1 = True And Status2 = True Then
            If Not pTrueFalse.Exists(True) Then
                pTrueFalse.Add Key:=True, Item:=Key
            Else
                pTrueFalse(True) = pTrueFalse(True) & "," & Key
            End If
        Else
            If Not pTrueFalse.Exists(False) Then
                pTrueFalse.Add Key:=False, Item:=Key
            Else
                pTrueFalse(False) = pTrueFalse(False) & "," & Key
            End If
        End If
End Function

Public Property Get TrueFalse() As Dictionary
   Set TrueFalse = pTrueFalse
End Property


Private Sub Class_Initialize()
    Set pTrueFalse = New Dictionary
End Sub

0
ответ дан Ron Rosenfeld 15 January 2019 в 19:51
поделиться
Другие вопросы по тегам:

Похожие вопросы: