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\to\excel\file.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屋！