Question

这个任务让我很生气......请帮忙！我没有手动输入数据，而是使用VBA查找年份范围，将其放入一列并删除所有重复的列。但是，由于excel可能会提供超过20年的时间，因此手动完成所有过滤将非常繁琐。并且，现在我需要excel来分隔三列中任何一列中包含特定年份范围的行，并将它们放入新工作表中。

e.g。 excel在三列（F：H）中可以找到的年份是（2001,2003,2006,2010,2012,2020 ..... 2033）..并且它们被粘贴在表1中的列“S”中。我怎么能告诉excel多年来创建新工作表（工作表2001，工作表2003，工作表2006 ...），在工作表1中搜索列（F：H）以查看这些列中是否包含该年份，并粘贴它们进入新表。更具体地说，在新创建的“Sheet 2001”中，应粘贴列（F：H）包含“2001”的整行。在新创建的“Sheet 2033”中，应粘贴列（F：H）包含“2033”的整行。

随函附上参考资料。 http://www.speedyshare.com/files/23851477/Book32.xls 我的片材“2002”和“2003”在这里作为结果，但对于真正的片材我将需要更多年的片材（在前一阶段可以提取多少excel;如L列所示）.... .. 我认为这个任务应该是很平常的（按日期提取），但我不能谷歌结果....请求帮助!!我对如何做LOOPING非常无能......所以请建议并提供更多细节！感谢

Answer 1

您在splite the entire row with a specific YEAR value to other worksheet. 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

根据一列将“年份”分成几个工作表

1 个答案: