时间戳

首页 > 解决方案 > Excel VBA 将某些数据向下复制 x 行数

excel - Excel VBA 将某些数据向下复制 x 行数

问题描述

我是 VBA 的新手，通常我只会求助于 excel 公式。我正在编写一个记录数据库，该数据库从用户选择的 Excel 表中提取信息。我在网上找到了我拼凑起来的代码：-

Sub Get_Data_From_File()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", Filefilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen, Password:="uraduct")
        Application.DisplayAlerts = False
        OpenBook.Sheets(1).Range("B3:B11").Copy
        ThisWorkbook.Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues, Transpose:=True
        Application.DisplayAlerts = False
        OpenBook.Sheets(1).Range("B19:U162").Copy
        ThisWorkbook.Worksheets("Data").Cells(Rows.Count, 10).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues, Transpose:=True
        OpenBook.Close False

End If
Application.ScreenUpdating = True
On Error Resume Next
Columns("K").SpecialCells(xlBlanks).EntireRow.Delete

End Sub

基本上，B3:B11 是一个标题，我希望它出现在 B19:U162 上的每一行上，它是 1 列或 20 列转换为行（基于最后的删除）。

此外，在某些情况下，用户没有填写第 19 行/第 19 列，因此如果第 20 行/第 20 行已填写，我想为第 19 行添加一个默认值，以防止它在下一次文件上传时被覆盖。

我希望这是有道理的。

谢谢，

标签： excelvba

解决方案

测试单元格（“B19”），如果为空，则计算第 20 行的列数，然后填写该行。关闭源工作簿而不保存更改。

Application.DisplayAlerts = False
Dim cols As Integer
If OpenBook.Sheets(1).Range("B19") = "" Then
    cols = OpenBook.Sheets(1).Cells(20, Columns.Count).End(xlToLeft).Column - 1
    OpenBook.Sheets(1).Range("B19").Resize(1, cols).Value = "empty"
End If
OpenBook.Sheets(1).Range("B19:U162").Copy

推荐阅读