Сортировка вещей, чтобы соответствовать информации на колонке

Question

Смотреть этот пример:

Я имею всю возможную информацию в первом столбце, вторая имеет только информацию о том, что существует Специальные условия. Строка, начинающаяся с этого второго столбца, показывает информацию о том, что существует.

Есть ли способ разобраться в этом?

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

Я принимаю ответы на макро или формулу, спасибо.

Answer 1

Попробуйте что-нибудь подобное. В вашем Vba язь вам придется есть инструмент -> Справочник и выберите «Microsoft ActiveX Data Ovjects 2.8 Library»

Option Explicit 

Private Sub SortExisting() 
Dim rsPossible As New ADODB.Recordset 
Dim rsExists As New ADODB.Recordset 
Dim ws As Excel.Worksheet 
Dim lRow As Long 
Dim lFind as Long 

    Set ws = Application.ActiveSheet 

    'Add fields to your recordset for storing data. You can store sums here. 
    With rsPossible 
     .Fields.Append "Row", adInteger 
     .Fields.Append ""Possible", adChar, 20 
     .Open 
    End With 

    With rsExists 
     .Fields.Append "Exists", adChar, 20 
     .Fields.Append "Value1", adChar, 30 
     .Fields.Append "Value2", adChar, 33 'Make the fields as big as they need to be. 
     .Fields.Append "Value3", adChar, 20 
     .Open 
    End With 

    lRow = 1 

    'Loop through and record what is in the columns. 
    Do While lRow <= ws.UsedRange.Rows.Count 

     rsPossible.AddNew 
     rsPossible.Fields("Row").Value = lRow 
     rsPossible.Fields("Possible").Value = ws.Range("C" & lRow).Value 
     rsPossible.Update 

     rsExists.AddNew 
     rsExists.Fields("Exists").Value = ws.Range("D" & lRow).Value 
     ws.Range("D" & lRow).Value = "" 
     rsExists.Fields("Value1").Value = ws.Range("E" & lRow).Value 
     ws.Range("E" & lRow).Value = "" 
     rsExists.Fields("Value2").Value = ws.Range("F" & lRow).Value 
     ws.Range("F" & lRow).Value = "" 
     rsExists.Fields("Value3").Value = ws.Range("G" & lRow).Value 
     ws.Range("G" & lRow).Value = "" 
     rsExists.Update 

     lRow = lRow + 1 
     ws.Range("A" & lRow).Activate 
    Loop 

    If rsExists.EOF = False Then 
     rsExists.MoveFirst 
    End If 

    'Here we loop through the existing 
    Do While rsExists.EOF = False 
     "Find the current existing in th 
     rsPossible.Filter = "" 
     rsPossible.Filter = "Possible='" & rsExist.fields("Exists").Value 
     lFind = rsPossible.Fields("Row").Value 

     'Write the value of the existing to the row of the possible 
     ws.Range("D" & lFind).Value = rsPossible.Fields("Exists").Value 
     ws.Range("E" & lFind).Value = rsPossible.Fields("Value1").Value 
     ws.Range("F" & lFind).Value = rsPossible.Fields("Value2").Value 
     ws.Range("G" & lFind).Value = rsPossible.Fields("Value3").Value 

    rsExists.MoveNext 
    Loop 

End Sub