如何使用表格的标题在Excel宏中将不同大小的不同表格从一个已知表格复制到另一个表格?

时间:2015-03-26 11:25:51

标签: excel-vba vba excel

我在名为“data”的工作表中打开了一个csv文件,该工作表有很多表。搜索req'd表的唯一链接因素是表的标题以sales_开头,例如sales_1sales_1985等。表的大小有时会有所不同;我需要通过“点击按钮”对这些表进行排序和导入!!我已经有了自己,直到我可以从sales_开始排序标题,但是当我尝试导入这些表时,我收到错误1004(附加)。到目前为止的代码也附上了,有人可以帮忙吗?

Private Sub CommandButton1_Click()

    Dim FirstAddress As String
    Dim FirstAddress1 As String
    Dim debt As Variant
    Dim growth As Variant
    Dim Rng As Range
    Dim Rng1 As Range
    Dim Rcount As Long
    Dim Rcount1 As Long
    Dim I As Long
    Dim J As Long
    Dim NewSh As Worksheet
    Dim Newsh1 As Worksheet
    Dim row As String

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Fill in the search Value
    debt = Array("Sales*Debt*_GMAP", "Sales*Growth*_GMAP")

    Set NewSh = Sheets("debtshow")
    Set Newsh1 = Sheets("tables")

    With Sheets("data").Range("A1:Z3000")

        Rcount = 0
        row = 0

        For I = LBound(debt) To UBound(debt)

            Set Rng = .Find(What:=debt(I), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                FirstAddress = Rng.Address
                Do
                    row = Rng.row + 3

                    Rcount = Rcount + 1
' I know I am doing something wrong here to copy the row(for starters, and then table) but I dont understand what!

                   Sheets("data").Range("row:row").Copy Newsh1.Range("2:2" & Rcount)
                    Rng.Copy NewSh.Range("A" & Rcount)

                    Set Rng = .FindNext(Rng)
                Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
            End If
        Next I
    End With

    With Application
        .ScreenUpdating = False
        .EnableEvents = True
    End With
End Sub

1 个答案:

答案 0 :(得分:0)

我假设你的数据看起来像这样:

sales_1    Data1      Data2      Data3
info1      info2      info3      info4
info5      info6      info7      info8
<blank>    <blank>    <blank>    <blank>
sales_2    Data1      Data2      Data3
info9      info10     info11     info12
info13     info14     info15     info16
<blank>    <blank>    <blank>    <blank>

基于该假设我建议将每组数据Sales_1Sales_2等转换为表格,以便日后可以更轻松地引用它们,例如这样:

Private Sub CommandButton1_Click()

    Dim FirstAddress As String
    'Dim debt As Variant
    Dim Rng As Range
    Dim Rng1 As Range
    Dim NewSh As Worksheet
    Dim Newsh1 As Worksheet
    Dim row As String

'leave this out until it's all working - it'll just frustrate you
'With Application
'    .ScreenUpdating = False
'    .EnableEvents = False
'End With

    'Fill in the search Value
    debt = Array("Sales*Debt*_GMAP", "Sales*Growth*_GMAP")

    Set NewSh = Sheets("debtshow")
    Set Newsh1 = Sheets("tables")

    With Sheets("data").UsedRange 'use this instead of hard coding your data range 
                                  'provides room for growth
    set rng = .find(What:="sales_", LookIn:=xlValues, lookAt:=xlPart, _
                    SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    while not rng is nothing then
      FirstAddress = Rng.Address
      set rng1 = .find(What:=Debt(I), LookIn:=xlValues, lookAt:=xlPart, _
                    'this should get you the row you just found in the previous search
                    after:=.rows(rng.rows(1)), _ 
                    SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
      if rng1 is nothing then
        row = .rows.count 'we've found the last one, run to the end
      else
        row = rng1.rows(1) - 2 'store the last row of the block of data
      end if

'now, make a table out of the data we found
'make the table name "sales_x" based on the cell we found
      .listobjects.add(xlSrcRange, .range(cells(rng.rows(1), .columns.count), cells(row, .columns.count), , xlYes).Name = rng.cells(1,1)

'at this point, you can use .ListObjects to copy this block of data somewhere
'or, you can leave the data as tables, then loop through later and copy them
'to where ever you need them
      rng = rng1 'we've already found where the next block of data starts so use it
    wend 

'With Application
'    .ScreenUpdating = False
'    .EnableEvents = True
'End With
End Sub

然而,我对您正在创建的Debt数组以及为什么要在公式(LookIn:=xlFormula)中搜索这些值感到困惑,因为那似乎不是任何部分问题的文字描述。此代码忽略该代码并按您所述搜索Sales_x。如果您需要搜索Debt(),则需要相应地修改.Find()语句。