对事物进行排序以匹配列上的信息

时间:2015-07-08 11:01:45

标签: excel excel-vba sorting excel-formula vba

观看此示例:

example

我在第一列中有所有可能的信息,第二列只有phisically存在的信息。从第二列开始的行显示了存在的信息。

有没有办法解决这个问题?

Sorted things

我尝试按字母顺序排序,但它没有像我演示的那样起作用。另请注意,这只是一个例子。 在我的主要床单中,事情并不恰当,但我的观点仍然存在。

我接受宏观或公式答案,谢谢。

1 个答案:

答案 0 :(得分:0)

尝试这样的事情。 在你的vba ide中你必须得到工具 - >参考和选择 “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