0

我对 Excel VBA 有点陌生，但我遇到了一些问题，我尝试了一些东西，但我知道的不够多，无法做到正确。

事情是这样的，我在 workbook1 中有一个表单，在其中我从日历中选择开始日期和结束日期，一旦选择，我按下一个按钮，我必须从关闭的文件中复制让我们调用 workbook2 从那个开始的所有元素日期到结束日期。

因此，如果我从 19-08-2013 到 25-08-2013 选择，我希望将元素 2 到元素 11 复制到工作簿 1

Workbook2（数千个元素日期等）：

 ╔═══╦════════════╦═════════════╦═════════════╦═════════════╦═════════════╗
 ║   ║    A       ║      B      ║      c      ║      D      ║      E      ║
 ╠═══╬════════════╬═════════════╬═════════════╬═════════════╬═════════════╣
 ║ 1 ║ Type       ║ Element 1   ║             ║ 16-08-2013  ║ 18-08-2013  ║
 ║ 1 ║ Type       ║ Element 2   ║             ║ 19-08-2013  ║ 22-08-2013  ║
 ║ 2 ║ Header     ║ Element 3   ║             ║ 19-08-2013  ║ 22-08-2013  ║
 ║ 3 ║ Auto Align ║ Element 4   ║             ║ 19-08-2013  ║ 22-08-2013  ║
 ║ 4 ║ Auto Align ║ Element 5   ║             ║ 19-08-2013  ║ 22-08-2013  ║
 ║ 5 ║ Auto Align ║ Element 6   ║             ║ 19-08-2013  ║ 22-08-2013  ║
 ║ 6 ║ Auto Align ║ Element 7   ║             ║ 23-08-2013  ║ 25-08-2013  ║
 ║ 7 ║ Auto Align ║ Element 8   ║             ║ 23-08-2013  ║ 25-08-2013  ║
 ║ 8 ║ Auto Align ║ Element 9   ║             ║ 23-08-2013  ║ 25-08-2013  ║
 ║ 9 ║ Auto Align ║ Element 10  ║             ║ 23-08-2013  ║ 25-08-2013  ║
 ║10 ║ Auto Align ║ Element 11  ║             ║ 23-08-2013  ║ 25-08-2013  ║
 ║11 ║ Auto Align ║ Element 12  ║             ║ 26-08-2013  ║ 01-09-2013  ║
 ║12 ║ Auto Align ║ Element 13  ║             ║ 26-08-2013  ║ 01-09-2013  ║
 ║13 ║ Auto Align ║ Element 14  ║             ║ 26-08-2013  ║ 01-09-2013  ║
 ║14 ║ Auto Align ║ Element 15  ║             ║ 26-08-2013  ║ 01-09-2013  ║
 ║15 ║ Auto Align ║ Element 16  ║             ║ 26-08-2013  ║ 01-09-2013  ║
 ║.. ║    ...     ║     ...     ║     ...     ║     ...     ║     ...     ║
 ║ n ║     n      ║ Element n   ║             ║  start date ║ end date    ║
 ╚═══╩════════════╩═════════════╩═════════════╩═════════════╩═════════════╝

工作簿1：

╔═══╦════════════╗
║   ║    A       ║
╠═══╬════════════╣
║ 1 ║ Element 2  ║
║ 2 ║ Element 3  ║
║ 3 ║ Element 4  ║
║ 4 ║ Element 5  ║
║ 5 ║ Element 6  ║
║ 6 ║ Element 7  ║
║ 7 ║ Element 8  ║
║ 8 ║ Element 9  ║
║ 9 ║ Element 10 ║ 
║10 ║ Element 11 ║
╚═══╩════════════╝

到目前为止，这就是我的 update(actualizar) 按钮：

私有子实现器_Click()

If calendario.SelStart + 6 = calendario.SelEnd Then //calendario is the calendar
    Sheets("variables").Range("B1").Value = calendario.SelStart //i just copy the
    Sheets("variables").Range("B2").Value = calendario.SelEnd   //selected date to wb1

    '///// code to get data

    Dim wb As Workbook
    Application.ScreenUpdating = False ' turn off the screen updating
    Set wb = Workbooks.Open("C:\Users\G\Desktop\AnalyticsBuilder\Panel a completarCOPIA.xlsx", True, True)
    ' open the source workbook, read only


    Dim c As Range
    Dim x As Range
    Set x = Range("C5")

    For Each c In wb.Worksheets("2012").Range("K:K")
        If c.Value >= calendario.SelStart And c.Value <= calendario.SelEnd Then

          ThisWorkbook.Worksheets("variables").x.Value = wb.Worksheets("2012").c.Value

        End If
    Next c


    wb.Close False ' close the source workbook without saving any changes
    Set wb = Nothing ' free memory

    Application.ScreenUpdating = True ' turn on the screen updating
    Unload Me

ElseIf calendario.SelStart + 6 <> calendario.SelEnd Then
    MsgBox ("Seleccionar semana completa"), , "Error"
End If

结束子

我已经成功尝试从封闭的 wb2 复制一个单元格，但是获取该元素的这段代码不起作用。

在获取数据之前，从关闭的 wb 复制也会使 excel 冻结几秒钟，有没有办法解决这个问题？

希望您能对此有所帮助，在此先感谢您。

4

2 回答 2

0

也许...

Private Sub actualizar_Click()

    Dim wsDest As Worksheet
    Dim DateCell As Range
    Dim arrResults(1 To 65000) As Variant
    Dim ResultIndex As Long

    Set wsDest = ThisWorkbook.Sheets("variables")

    If calendario.SelStart + 6 = calendario.SelEnd Then '//calendario is the calendar

        wsDest.Range("B1:B2").Value = Application.Transpose(Array(calendario.SelStart, calendario.SelEnd))

        Application.ScreenUpdating = False ' turn off the screen updating
        With Workbooks.Open("C:\Users\G\Desktop\AnalyticsBuilder\Panel a completarCOPIA.xlsx", True, True)

            For Each DateCell In Intersect(.Sheets("2012").UsedRange, .Sheets("2012").Columns("K"))
                If IsDate(DateCell.Value) Then
                    If DateCell.Value >= calendario.SelStart And DateCell.Value <= calendario.SelEnd Then
                        ResultIndex = ResultIndex + 1
                        arrResults(ResultIndex) = DateCell.Text
                    End If
                End If
            Next DateCell
            .Close False
        End With

        If ResultIndex > 0 Then wsDest.Cells(Rows.Count, "C").End(xlUp).Offset(1).Resize(ResultIndex).Value = Application.Transpose(arrResults)

        Application.ScreenUpdating = True ' turn on the screen updating
        Unload Me

    ElseIf calendario.SelStart + 6 <> calendario.SelEnd Then
        MsgBox ("Seleccionar semana completa"), , "Error"
    End If

End Sub
于 2013-09-03T19:03:09.837 回答
0

看这里。但下面是我有时使用的东西。

Function xFind2B(xS As Worksheet)
    On Error Resume Next

    Dim c As Range
    Dim xRng As Range
    Set xRng = xS.Range("D1:D20")

    For Each c In xRng
        If c.Value => textbox.value And <= textbox2.value Then
            'Do Your copy
            Exit For
        End If
    Next c

    xFind2BlanksA = c.Offset(-1).Row

    On Error GoTo 0
End Function
于 2013-09-01T08:22:01.767 回答