Разделите «Год» на несколько листов в соответствии с одним столбцом

Question

Эта задача сводит меня с ума ... пожалуйста, помогите! Вместо того, чтобы вручную вводить данные, я использовал VBA, чтобы найти диапазон лет, поместить в один столбец и удалить все дубликаты. Но поскольку Excel может дать более 20 лет, было бы утомительно выполнять всю фильтрацию вручную. И, теперь мне нужно Excel, чтобы отделить строки, которые содержат определенный диапазон года в любом из трех столбцов и поместить их на новый лист.

например. Годы, которые Excel может найти в трех столбцах (F: H): (2001,2003,2006,2010, 2012,2020 ... 2033) ... и они вставлены в столбец "S" на листе 1. Как я могу сказать Excel создать новые таблицы за годы (листы 2001, листы 2003, лист2006 ....), выполнить поиск по столбцу (F: H) на листе 1, чтобы увидеть, содержит ли ЛЮБОЙ из этих столбцов тот год, и вставить их в новый лист. Более конкретно, во вновь созданном «Листе 2001» должна быть вставлена ​​вся строка, в которой столбец (F: H) содержит «2001». и во вновь созданном «Листе 2033» должна быть вставлена ​​вся строка, в которой столбец (F: H) содержит «2033».

Прилагается, пожалуйста, найдите ссылку. http://www.speedyshare.com/files/23851477/Book32.xls Я получил листы "2002" и "2003" здесь как результаты, но для реального мне понадобятся листы на несколько лет (столько, сколько Excel может извлечь на предыдущем этапе; как показано в столбце L) .... .. Я думаю, что это задание должно быть довольно обычным (извлечение по дате), но я не могу получить результат в Google .... Пожалуйста, помогите !! Я очень не знаю, как сделать LOOPING .. поэтому, пожалуйста, советуйте и дайте более подробную информацию! Спасибо

Answer 1

Вы попросили что-то похожее в разделить всю строку с конкретным значением ГОДА на другой лист.vba excel и я сказал, что вы можете использовать ADO.Это не окончательный код, это демонстрация:

Dim cn As Object
Dim rs As Object
Dim rs2 As Object
Dim sFile As String
Dim sCon As String
Dim sSQL As String
Dim s As String
Dim i As Integer, j As Integer

''This is not the best way to refer to the workbook
''you want, but it is very convenient for notes
''It is probably best to use the name of the workbook.

sFile = ActiveWorkbook.FullName

''Note that if HDR=No, F1,F2 etc are used for column names,
''if HDR=Yes, the names in the first row of the range
''can be used.
''This is the Jet 4 connection string, you can get more
''here : http://www.connectionstrings.com/excel

sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sFile _
    & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"

''Late binding, so no reference is needed

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Set rs2 = CreateObject("ADODB.Recordset")


cn.Open sCon

sSQL = "SELECT Year([ Date]) As YrDate " _
       & "FROM [Sheet1$] " _
       & "UNION " _
       & "SELECT Year([ Date i]) As YrDate " _
       & "FROM [Sheet1$] " _
       & "UNION " _
       & "SELECT Year([ Date ii]) As YrDate " _
       & "FROM [Sheet1$] " _
       & "UNION " _
       & "SELECT Year([Date iii]) As YrDate " _
       & "FROM [Sheet1$] "

rs.Open sSQL, cn, 3, 3

i = 3 ''Start adding worksheets at this number
Do While Not rs.EOF

sSQL = "SELECT Dte, Dta, Nmbr, No2, SerialNo FROM " _
       & "(SELECT [ Date] As Dte, [Data] As Dta, [ No] As Nmbr, " _
       & "[ No 2] As No2, [Serial No] As SerialNo " _
       & "FROM [Sheet1$] " _
       & "UNION ALL " _
       & "SELECT [ Date i] As Dte, [Data] As Dta, [ No] As Nmbr, " _
       & "[ No 2] As No2, [Serial No] As SerialNo " _
       & "FROM [Sheet1$] " _
       & "UNION ALL " _
       & "SELECT [ Date ii] As Dte, [Data] As Dta, [ No] As Nmbr, " _
       & "[ No 2] As No2, [Serial No] As SerialNo " _
       & "FROM [Sheet1$] " _
       & "UNION ALL " _
       & "SELECT [Date iii] As Dte, [Data] As Dta, [ No] As Nmbr, " _
       & "[ No 2] As No2, [Serial No] As SerialNo " _
       & "FROM [Sheet1$] ) " _
       & "WHERE Year(Dte)= " & rs!YrDate

    rs2.Open sSQL, cn, 3, 3

    ''Pick a suitable empty worksheet for the results
    Worksheets.Add
    With Worksheets("Sheet" & i)
        .Cells(1, 1) = rs!YrDate

        For j = 0 To rs2.Fields.Count - 1
            .Cells(2, j + 1) = rs2.Fields(j).Name
        Next

        .Cells(3, 1).CopyFromRecordset rs2
    End With

    rs.MoveNext
    i = i + 1
    rs2.Close
Loop

''Tidy up
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing