VBA:文本识别 - 将特定列从 sheet1 复制到 sheet2 [英] VBA: text recognition - copy specific columns from sheet1 to sheet2

问题描述

一个善良的灵魂为我问的另一个问题制作了这个代码.但我在考虑文本识别.所以我在sheet1中输入了一个数据，数据输入中的每一列都有一些标题，我想按特定的标题名称排序，复制它们，然后将标题与我的关键字匹配的列的两行粘贴到sheet2中.将数据粘贴到 sheet2 中，应该在可用的前两行，就像在我的代码中一样.真的想尽可能保留大部分代码，然后可能只更改我在特定范围内复制两行的子.感谢您的帮助:)

a kind soul made me this code for another question i asked. But im thinking about text recognition. So i got a data input in sheet1, there is some headers for each column in the data input, and i want to sort by specific header names, copy them, and paste the two rows of the columns which header matches my keywords, in sheet2. Pasting the data in sheet2, should be at the first two lines available, like here in my code already. Really want to keep most of the code as possible and then maybe only change the sub where i copy the two rows in a specific range. Would appreciate the help:)

Option Explicit

Sub call_copy_sub_ranges()

    Dim ws1 As Worksheet, wsOut As Worksheet
    Set ws1 = ThisWorkbook.Worksheets("Ark1")
    Set wsOut = ThisWorkbook.Worksheets("Ark2")

    Dim ar
    ar = Array("HeaderA", "HeaderB", "HeaderC", "HeaderD", "HeaderE", _
    "HeaderF", "HeaderG", "HeaderH", "HeaderI", "HeaderJ", "HeaderK", _
    "HeaderL", "HeaderM", "HeaderN", "HeaderO", "HeaderP", "HeaderQ", _
    "HeaderR", "HeaderS", "HeaderT", "HeaderU", "HeaderV", "HeaderW", _
    "HeaderX", "HeaderY", "HeaderZ", "HeaderAA", "HeaderAB", "HeaderAC", _
    "HeaderAD", "HeaderAE", "HeaderAF", "HeaderAG", "HeaderAH", "HeaderAI", _
    "HeaderAJ", "HeaderAK", "HeaderAL", "HeaderAM", "HeaderAN", "HeaderAO", _
    "HeaderAP", "HeaderAQ", "HeaderAR", "HeaderAS", "HeaderAT", "HeaderAU", _
    "HeaderAV", "HeaderAW", "HeaderAX", "HeaderAY")
   
    wsOut.Range("A1:AY1").Value = ar
    copy_sub_ranges ws1, wsOut
    MsgBox "Done"

End Sub


Sub copy_sub_ranges(ByVal ws1 As Worksheet, ByVal wsOut As Worksheet)

    Dim rng As Range, rngOut As Range, ar, s
    ar = Array("S2:S3", "BF7:BH8", "BI9:CC10", _
    "CD9:CQ9", "CR9:CS10", "CT9:CV9", "CW9:CW10", "CX10", "EE9:EI10")
               
    ' target
    Set rngOut = wsOut.Cells(wsOut.Rows.Count, 1).End(xlUp)
    If Not IsEmpty(wsOut.Range("A1").Text) Then
        Set rngOut = rngOut.offset(1, 0)
    End If

    For Each s In ar
        Set rng = ws1.Range(s)
        Debug.Print rng.Address, rngOut.Address
   
        rng.Copy rngOut
        Set rngOut = rngOut.offset(0, rng.Columns.Count)
    Next

    ' underline
    Set rng = wsOut.Cells(wsOut.Rows.Count, 1).End(xlUp)
    With rng.Resize(1, rngOut.Column - 1).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .Weight = xlMedium
    End With

End Sub

推荐答案

您可以在工作表或工作表中的某个范围内执行 SQL 语句.这将允许您只选择特定的列，并按特定的列排序.

You could execute an SQL statement on your worksheet, or on a range within the worksheet. This would allow you to trivially select only specific columns, and sort by specific columns.

添加对 Microsoft ActiveX 数据对象的引用(工具 -> 引用...)；选择最新版本(通常是 6.1).

Add a reference (Tools -> References...) to Microsoft ActiveX Data Objects; choose the latest version (usually 6.1).

然后您可以编写类似于以下内容的代码:

Then you could write code similar to the following:

Dim sql As String
sql = _
    "SELECT HeaderA, HeaderG, HeaderP "  & _
    "FROM [Sheet1$] " & _
    "ORDER BY HeaderQ, HeaderR"

' If your data is only in a specific range, you can limit to that range:
'sql = _
'    "SELECT HeaderA, HeaderG, HeaderP "  & _
'    "FROM [Sheet1$B5:AA17] " & _
'    "ORDER BY HeaderQ, HeaderR"

Const filepath As String = "C:path	oexcelfile.xlsx"

Dim connectionString As String
connectionString = _
    "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=""" & filepath & """;" & _
    "Extended Properties=""Excel 12.0;HDR=Yes"""

Dim rs As New ADODB.Recordset
rs.Open sql, connectionString

ThisWorkbook.Worksheets("Ark2").Range("A1").CopyFromRecordset rs

请注意，没有什么可以阻止您将字符串数组用作选定列或排序字段；使用 Join 函数将字段名称组合成逗号分隔的字符串:

Note that there's nothing preventing you from using an array of strings as the selected columns, or as the sort fields; use the Join function to combine the field names into a comma-separated string:

Dim fieldnames() As String
fieldnames = Array("HeaderB", "HeaderC", "HeaderD")

Dim sortnames() As String
sortnames = Array("HeaderM", "HeaderN", "HeaderO")

sql = _
    "SELECT " & Join(fieldnames, ", ") & " " & _
    "FROM [Sheet1$] " & _
    "ORDER BY " & Join(sortnames, ", ")

fieldnames 和 sortnames 可以从不同的单元格填充:

fieldnames and sortnames could be populated from different cells:

Dim sheet As Worksheet
Set sheet = Worksheets("Sheet1")
fieldnames = Array(sheet.Range("A1").Value, sheet.Range("B1").Value))

这篇关于VBA:文本识别 - 将特定列从 sheet1 复制到 sheet2的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！